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)
15 include 'COMMON.FFIELD'
16 include 'COMMON.DERIV'
17 include 'COMMON.INTERACT'
18 include 'COMMON.SBRIDGE'
19 include 'COMMON.CHAIN'
20 include 'COMMON.SHIELD'
21 include 'COMMON.CONTROL'
22 include 'COMMON.TORCNSTR'
23 double precision fact(6)
24 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
26 cd print *,'nnt=',nnt,' nct=',nct
28 C Compute the side-chain and electrostatic interaction energy
30 goto (101,102,103,104,105) ipot
31 C Lennard-Jones potential.
32 101 call elj(evdw,evdw_t)
33 cd print '(a)','Exit ELJ'
35 C Lennard-Jones-Kihara potential (shifted).
36 102 call eljk(evdw,evdw_t)
38 C Berne-Pechukas potential (dilated LJ, angular dependence).
39 103 call ebp(evdw,evdw_t)
41 C Gay-Berne potential (shifted LJ, angular dependence).
42 104 call egb(evdw,evdw_t)
44 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
45 105 call egbv(evdw,evdw_t)
46 C write(iout,*) 'po elektostatyce'
48 C Calculate electrostatic (H-bonding) energy of the main chain.
52 if (shield_mode.eq.1) then
54 else if (shield_mode.eq.2) then
57 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
58 C write(iout,*) 'po eelec'
60 C Calculate excluded-volume interaction energy between peptide groups
63 call escp(evdw2,evdw2_14)
65 c Calculate the bond-stretching energy
69 C write (iout,*) "estr",estr
71 C Calculate the disulfide-bridge and other energy and the contributions
72 C from other distance constraints.
73 cd print *,'Calling EHPB'
75 cd print *,'EHPB exitted succesfully.'
77 C Calculate the virtual-bond-angle energy.
79 C print *,'Bend energy finished.'
81 if (tor_mode.eq.0) then
84 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
92 if (with_theta_constr) call etheta_constr(ethetacnstr)
93 c call ebend(ebe,ethetacnstr)
94 cd print *,'Bend energy finished.'
96 C Calculate the SC local energy.
99 C print *,'SCLOC energy finished.'
101 C Calculate the virtual-bond torsional energy.
103 if (wtor.gt.0.0d0) then
104 if (tor_mode.eq.0) then
105 call etor(etors,fact(1))
107 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
109 call etor_kcc(etors,fact(1))
115 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
116 c print *,"Processor",myrank," computed Utor"
118 C 6/23/01 Calculate double-torsional energy
120 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
121 call etor_d(etors_d,fact(2))
125 c print *,"Processor",myrank," computed Utord"
127 call eback_sc_corr(esccor)
129 if (wliptran.gt.0) then
130 call Eliptransfer(eliptran)
134 C 12/1/95 Multi-body terms
138 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
139 & .or. wturn6.gt.0.0d0) then
140 c write(iout,*)"calling multibody_eello"
141 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
142 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
143 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
150 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
151 c write (iout,*) "Calling multibody_hbond"
152 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
154 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
156 if (shield_mode.gt.0) then
157 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
159 & +fact(1)*wvdwpp*evdw1
160 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
161 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
162 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
163 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
164 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
165 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
168 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
170 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
171 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
172 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
173 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
174 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
175 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
179 if (shield_mode.gt.0) then
180 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
181 & +welec*fact(1)*(ees+evdw1)
182 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
183 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
184 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
185 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
186 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
187 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
190 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
191 & +welec*fact(1)*(ees+evdw1)
192 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
193 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
194 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
195 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
196 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
197 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
204 energia(2)=evdw2-evdw2_14
221 energia(8)=eello_turn3
222 energia(9)=eello_turn4
231 energia(20)=edihcnstr
233 energia(24)=ethetacnstr
238 if (isnan(etot).ne.0) energia(0)=1.0d+99
240 if (isnan(etot)) energia(0)=1.0d+99
245 idumm=proc_proc(etot,i)
247 call proc_proc(etot,i)
249 if(i.eq.1)energia(0)=1.0d+99
255 call enerprint(energia,fact)
259 C Sum up the components of the Cartesian gradient.
264 if (shield_mode.eq.0) then
265 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
266 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
268 & wstrain*ghpbc(j,i)+
269 & wcorr*fact(3)*gradcorr(j,i)+
270 & wel_loc*fact(2)*gel_loc(j,i)+
271 & wturn3*fact(2)*gcorr3_turn(j,i)+
272 & wturn4*fact(3)*gcorr4_turn(j,i)+
273 & wcorr5*fact(4)*gradcorr5(j,i)+
274 & wcorr6*fact(5)*gradcorr6(j,i)+
275 & wturn6*fact(5)*gcorr6_turn(j,i)+
276 & wsccor*fact(2)*gsccorc(j,i)
277 & +wliptran*gliptranc(j,i)
278 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
280 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
281 & wsccor*fact(2)*gsccorx(j,i)
282 & +wliptran*gliptranx(j,i)
284 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
285 & +fact(1)*wscp*gvdwc_scp(j,i)+
286 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
288 & wstrain*ghpbc(j,i)+
289 & wcorr*fact(3)*gradcorr(j,i)+
290 & wel_loc*fact(2)*gel_loc(j,i)+
291 & wturn3*fact(2)*gcorr3_turn(j,i)+
292 & wturn4*fact(3)*gcorr4_turn(j,i)+
293 & wcorr5*fact(4)*gradcorr5(j,i)+
294 & wcorr6*fact(5)*gradcorr6(j,i)+
295 & wturn6*fact(5)*gcorr6_turn(j,i)+
296 & wsccor*fact(2)*gsccorc(j,i)
297 & +wliptran*gliptranc(j,i)
298 & +welec*gshieldc(j,i)
299 & +welec*gshieldc_loc(j,i)
300 & +wcorr*gshieldc_ec(j,i)
301 & +wcorr*gshieldc_loc_ec(j,i)
302 & +wturn3*gshieldc_t3(j,i)
303 & +wturn3*gshieldc_loc_t3(j,i)
304 & +wturn4*gshieldc_t4(j,i)
305 & +wturn4*gshieldc_loc_t4(j,i)
306 & +wel_loc*gshieldc_ll(j,i)
307 & +wel_loc*gshieldc_loc_ll(j,i)
309 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
310 & +fact(1)*wscp*gradx_scp(j,i)+
312 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
313 & wsccor*fact(2)*gsccorx(j,i)
314 & +wliptran*gliptranx(j,i)
315 & +welec*gshieldx(j,i)
316 & +wcorr*gshieldx_ec(j,i)
317 & +wturn3*gshieldx_t3(j,i)
318 & +wturn4*gshieldx_t4(j,i)
319 & +wel_loc*gshieldx_ll(j,i)
327 if (shield_mode.eq.0) then
328 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
329 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
331 & wcorr*fact(3)*gradcorr(j,i)+
332 & wel_loc*fact(2)*gel_loc(j,i)+
333 & wturn3*fact(2)*gcorr3_turn(j,i)+
334 & wturn4*fact(3)*gcorr4_turn(j,i)+
335 & wcorr5*fact(4)*gradcorr5(j,i)+
336 & wcorr6*fact(5)*gradcorr6(j,i)+
337 & wturn6*fact(5)*gcorr6_turn(j,i)+
338 & wsccor*fact(2)*gsccorc(j,i)
339 & +wliptran*gliptranc(j,i)
340 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
342 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
343 & wsccor*fact(1)*gsccorx(j,i)
344 & +wliptran*gliptranx(j,i)
346 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
347 & fact(1)*wscp*gvdwc_scp(j,i)+
348 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
350 & wcorr*fact(3)*gradcorr(j,i)+
351 & wel_loc*fact(2)*gel_loc(j,i)+
352 & wturn3*fact(2)*gcorr3_turn(j,i)+
353 & wturn4*fact(3)*gcorr4_turn(j,i)+
354 & wcorr5*fact(4)*gradcorr5(j,i)+
355 & wcorr6*fact(5)*gradcorr6(j,i)+
356 & wturn6*fact(5)*gcorr6_turn(j,i)+
357 & wsccor*fact(2)*gsccorc(j,i)
358 & +wliptran*gliptranc(j,i)
359 & +welec*gshieldc(j,i)
360 & +welec*gshieldc_loc(j,i)
361 & +wcorr*gshieldc_ec(j,i)
362 & +wcorr*gshieldc_loc_ec(j,i)
363 & +wturn3*gshieldc_t3(j,i)
364 & +wturn3*gshieldc_loc_t3(j,i)
365 & +wturn4*gshieldc_t4(j,i)
366 & +wturn4*gshieldc_loc_t4(j,i)
367 & +wel_loc*gshieldc_ll(j,i)
368 & +wel_loc*gshieldc_loc_ll(j,i)
370 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
371 & fact(1)*wscp*gradx_scp(j,i)+
373 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
374 & wsccor*fact(1)*gsccorx(j,i)
375 & +wliptran*gliptranx(j,i)
376 & +welec*gshieldx(j,i)
377 & +wcorr*gshieldx_ec(j,i)
378 & +wturn3*gshieldx_t3(j,i)
379 & +wturn4*gshieldx_t4(j,i)
380 & +wel_loc*gshieldx_ll(j,i)
389 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
390 & +wcorr5*fact(4)*g_corr5_loc(i)
391 & +wcorr6*fact(5)*g_corr6_loc(i)
392 & +wturn4*fact(3)*gel_loc_turn4(i)
393 & +wturn3*fact(2)*gel_loc_turn3(i)
394 & +wturn6*fact(5)*gel_loc_turn6(i)
395 & +wel_loc*fact(2)*gel_loc_loc(i)
396 c & +wsccor*fact(1)*gsccor_loc(i)
397 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
400 if (dyn_ss) call dyn_set_nss
403 C------------------------------------------------------------------------
404 subroutine enerprint(energia,fact)
405 implicit real*8 (a-h,o-z)
407 include 'DIMENSIONS.ZSCOPT'
408 include 'COMMON.IOUNITS'
409 include 'COMMON.FFIELD'
410 include 'COMMON.SBRIDGE'
411 include 'COMMON.CONTROL'
412 double precision energia(0:max_ene),fact(6)
414 evdw=energia(1)+fact(6)*energia(21)
416 evdw2=energia(2)+energia(17)
428 eello_turn3=energia(8)
429 eello_turn4=energia(9)
430 eello_turn6=energia(10)
437 edihcnstr=energia(20)
439 ethetacnstr=energia(24)
442 if (shield_mode.gt.0) then
443 write (iout,10) evdw,wsc*fact(1),evdw2,wscp*fact(1),ees,
444 & welec*fact(1),evdw1,wvdwpp*fact(1),
445 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
446 & etors_d,wtor_d*fact(2),ehpb,wstrain,
447 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
448 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
449 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
450 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
451 & eliptran,wliptran,etot
453 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
455 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
456 & etors_d,wtor_d*fact(2),ehpb,wstrain,
457 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
458 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
459 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
460 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
461 & eliptran,wliptran,etot
463 10 format (/'Virtual-chain energies:'//
464 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
465 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
466 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
467 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
468 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
469 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
470 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
471 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
472 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
473 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
474 & ' (SS bridges & dist. cnstr.)'/
475 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
476 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
477 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
478 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
479 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
480 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
481 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
482 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
483 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
484 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
485 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
486 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
487 & 'ETOT= ',1pE16.6,' (total)')
489 if (shield_mode.gt.0) then
490 write (iout,10) evdw,wsc*fact(1),evdw2,wscp*fact(2),ees,
491 & welec*fact(1),estr,wbond,
492 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
493 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
494 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
495 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
496 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
497 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot
499 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
500 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
501 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
502 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
503 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
504 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
505 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot
507 10 format (/'Virtual-chain energies:'//
508 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
509 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
510 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
511 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
512 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
513 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
514 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
515 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
516 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
517 & ' (SS bridges & dist. cnstr.)'/
518 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
519 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
520 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
521 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
522 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
523 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
524 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
525 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
526 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
527 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
528 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
529 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
530 & 'ETOT= ',1pE16.6,' (total)')
534 C-----------------------------------------------------------------------
535 subroutine elj(evdw,evdw_t)
537 C This subroutine calculates the interaction energy of nonbonded side chains
538 C assuming the LJ potential of interaction.
540 implicit real*8 (a-h,o-z)
542 include 'DIMENSIONS.ZSCOPT'
543 include "DIMENSIONS.COMPAR"
544 parameter (accur=1.0d-10)
547 include 'COMMON.LOCAL'
548 include 'COMMON.CHAIN'
549 include 'COMMON.DERIV'
550 include 'COMMON.INTERACT'
551 include 'COMMON.TORSION'
552 include 'COMMON.ENEPS'
553 include 'COMMON.SBRIDGE'
554 include 'COMMON.NAMES'
555 include 'COMMON.IOUNITS'
556 include 'COMMON.CONTACTS'
560 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
564 eneps_temp(j,i)=0.0d0
573 if (itypi.eq.ntyp1) cycle
574 itypi1=iabs(itype(i+1))
581 C Calculate SC interaction energy.
584 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
585 cd & 'iend=',iend(i,iint)
586 do j=istart(i,iint),iend(i,iint)
588 if (itypj.eq.ntyp1) cycle
592 C Change 12/1/95 to calculate four-body interactions
593 rij=xj*xj+yj*yj+zj*zj
595 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
596 eps0ij=eps(itypi,itypj)
601 ij=icant(itypi,itypj)
603 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
604 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
607 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
608 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
609 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
610 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
611 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
612 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
613 if (bb.gt.0.0d0) then
620 C Calculate the components of the gradient in DC and X
622 fac=-rrij*(e1+evdwij)
627 gvdwx(k,i)=gvdwx(k,i)-gg(k)
628 gvdwx(k,j)=gvdwx(k,j)+gg(k)
632 gvdwc(l,k)=gvdwc(l,k)+gg(l)
637 C 12/1/95, revised on 5/20/97
639 C Calculate the contact function. The ith column of the array JCONT will
640 C contain the numbers of atoms that make contacts with the atom I (of numbers
641 C greater than I). The arrays FACONT and GACONT will contain the values of
642 C the contact function and its derivative.
644 C Uncomment next line, if the correlation interactions include EVDW explicitly.
645 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
646 C Uncomment next line, if the correlation interactions are contact function only
647 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
649 sigij=sigma(itypi,itypj)
650 r0ij=rs0(itypi,itypj)
652 C Check whether the SC's are not too far to make a contact.
655 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
656 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
658 if (fcont.gt.0.0D0) then
659 C If the SC-SC distance if close to sigma, apply spline.
660 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
661 cAdam & fcont1,fprimcont1)
662 cAdam fcont1=1.0d0-fcont1
663 cAdam if (fcont1.gt.0.0d0) then
664 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
665 cAdam fcont=fcont*fcont1
667 C Uncomment following 4 lines to have the geometric average of the epsilon0's
668 cga eps0ij=1.0d0/dsqrt(eps0ij)
670 cga gg(k)=gg(k)*eps0ij
672 cga eps0ij=-evdwij*eps0ij
673 C Uncomment for AL's type of SC correlation interactions.
675 num_conti=num_conti+1
677 facont(num_conti,i)=fcont*eps0ij
678 fprimcont=eps0ij*fprimcont/rij
680 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
681 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
682 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
683 C Uncomment following 3 lines for Skolnick's type of SC correlation.
684 gacont(1,num_conti,i)=-fprimcont*xj
685 gacont(2,num_conti,i)=-fprimcont*yj
686 gacont(3,num_conti,i)=-fprimcont*zj
687 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
688 cd write (iout,'(2i3,3f10.5)')
689 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
695 num_cont(i)=num_conti
700 gvdwc(j,i)=expon*gvdwc(j,i)
701 gvdwx(j,i)=expon*gvdwx(j,i)
705 C******************************************************************************
709 C To save time, the factor of EXPON has been extracted from ALL components
710 C of GVDWC and GRADX. Remember to multiply them by this factor before further
713 C******************************************************************************
716 C-----------------------------------------------------------------------------
717 subroutine eljk(evdw,evdw_t)
719 C This subroutine calculates the interaction energy of nonbonded side chains
720 C assuming the LJK potential of interaction.
722 implicit real*8 (a-h,o-z)
724 include 'DIMENSIONS.ZSCOPT'
725 include "DIMENSIONS.COMPAR"
728 include 'COMMON.LOCAL'
729 include 'COMMON.CHAIN'
730 include 'COMMON.DERIV'
731 include 'COMMON.INTERACT'
732 include 'COMMON.ENEPS'
733 include 'COMMON.IOUNITS'
734 include 'COMMON.NAMES'
739 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
742 eneps_temp(j,i)=0.0d0
749 if (itypi.eq.ntyp1) cycle
750 itypi1=iabs(itype(i+1))
755 C Calculate SC interaction energy.
758 do j=istart(i,iint),iend(i,iint)
760 if (itypj.eq.ntyp1) cycle
764 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
766 e_augm=augm(itypi,itypj)*fac_augm
769 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
770 fac=r_shift_inv**expon
774 ij=icant(itypi,itypj)
775 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
776 & /dabs(eps(itypi,itypj))
777 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
778 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
779 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
780 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
781 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
782 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
783 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
784 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
785 if (bb.gt.0.0d0) then
792 C Calculate the components of the gradient in DC and X
794 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
799 gvdwx(k,i)=gvdwx(k,i)-gg(k)
800 gvdwx(k,j)=gvdwx(k,j)+gg(k)
804 gvdwc(l,k)=gvdwc(l,k)+gg(l)
814 gvdwc(j,i)=expon*gvdwc(j,i)
815 gvdwx(j,i)=expon*gvdwx(j,i)
821 C-----------------------------------------------------------------------------
822 subroutine ebp(evdw,evdw_t)
824 C This subroutine calculates the interaction energy of nonbonded side chains
825 C assuming the Berne-Pechukas potential of interaction.
827 implicit real*8 (a-h,o-z)
829 include 'DIMENSIONS.ZSCOPT'
830 include "DIMENSIONS.COMPAR"
833 include 'COMMON.LOCAL'
834 include 'COMMON.CHAIN'
835 include 'COMMON.DERIV'
836 include 'COMMON.NAMES'
837 include 'COMMON.INTERACT'
838 include 'COMMON.ENEPS'
839 include 'COMMON.IOUNITS'
840 include 'COMMON.CALC'
842 c double precision rrsave(maxdim)
848 eneps_temp(j,i)=0.0d0
853 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
854 c if (icall.eq.0) then
862 if (itypi.eq.ntyp1) cycle
863 itypi1=iabs(itype(i+1))
867 dxi=dc_norm(1,nres+i)
868 dyi=dc_norm(2,nres+i)
869 dzi=dc_norm(3,nres+i)
870 dsci_inv=vbld_inv(i+nres)
872 C Calculate SC interaction energy.
875 do j=istart(i,iint),iend(i,iint)
878 if (itypj.eq.ntyp1) cycle
879 dscj_inv=vbld_inv(j+nres)
880 chi1=chi(itypi,itypj)
881 chi2=chi(itypj,itypi)
888 alf12=0.5D0*(alf1+alf2)
889 C For diagnostics only!!!
902 dxj=dc_norm(1,nres+j)
903 dyj=dc_norm(2,nres+j)
904 dzj=dc_norm(3,nres+j)
905 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
906 cd if (icall.eq.0) then
912 C Calculate the angle-dependent terms of energy & contributions to derivatives.
914 C Calculate whole angle-dependent part of epsilon and contributions
916 fac=(rrij*sigsq)**expon2
919 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
920 eps2der=evdwij*eps3rt
921 eps3der=evdwij*eps2rt
922 evdwij=evdwij*eps2rt*eps3rt
923 ij=icant(itypi,itypj)
924 aux=eps1*eps2rt**2*eps3rt**2
925 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
926 & /dabs(eps(itypi,itypj))
927 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
928 if (bb.gt.0.0d0) then
935 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
937 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
938 & restyp(itypi),i,restyp(itypj),j,
939 & epsi,sigm,chi1,chi2,chip1,chip2,
940 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
941 & om1,om2,om12,1.0D0/dsqrt(rrij),
944 C Calculate gradient components.
945 e1=e1*eps1*eps2rt**2*eps3rt**2
946 fac=-expon*(e1+evdwij)
949 C Calculate radial part of the gradient
953 C Calculate the angular part of the gradient and sum add the contributions
954 C to the appropriate components of the Cartesian gradient.
963 C-----------------------------------------------------------------------------
964 subroutine egb(evdw,evdw_t)
966 C This subroutine calculates the interaction energy of nonbonded side chains
967 C assuming the Gay-Berne potential of interaction.
969 implicit real*8 (a-h,o-z)
971 include 'DIMENSIONS.ZSCOPT'
972 include "DIMENSIONS.COMPAR"
973 include 'COMMON.CONTROL'
976 include 'COMMON.LOCAL'
977 include 'COMMON.CHAIN'
978 include 'COMMON.DERIV'
979 include 'COMMON.NAMES'
980 include 'COMMON.INTERACT'
981 include 'COMMON.ENEPS'
982 include 'COMMON.IOUNITS'
983 include 'COMMON.CALC'
984 include 'COMMON.SBRIDGE'
987 integer icant,xshift,yshift,zshift
991 eneps_temp(j,i)=0.0d0
994 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
998 c if (icall.gt.0) lprn=.true.
1000 do i=iatsc_s,iatsc_e
1001 itypi=iabs(itype(i))
1002 if (itypi.eq.ntyp1) cycle
1003 itypi1=iabs(itype(i+1))
1007 C returning the ith atom to box
1009 if (xi.lt.0) xi=xi+boxxsize
1011 if (yi.lt.0) yi=yi+boxysize
1013 if (zi.lt.0) zi=zi+boxzsize
1014 if ((zi.gt.bordlipbot)
1015 &.and.(zi.lt.bordliptop)) then
1016 C the energy transfer exist
1017 if (zi.lt.buflipbot) then
1018 C what fraction I am in
1020 & ((zi-bordlipbot)/lipbufthick)
1021 C lipbufthick is thickenes of lipid buffore
1022 sslipi=sscalelip(fracinbuf)
1023 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1024 elseif (zi.gt.bufliptop) then
1025 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1026 sslipi=sscalelip(fracinbuf)
1027 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1037 dxi=dc_norm(1,nres+i)
1038 dyi=dc_norm(2,nres+i)
1039 dzi=dc_norm(3,nres+i)
1040 dsci_inv=vbld_inv(i+nres)
1042 C Calculate SC interaction energy.
1044 do iint=1,nint_gr(i)
1045 do j=istart(i,iint),iend(i,iint)
1046 c write (iout,*) "i j",i,j," dyn_ss_mask",dyn_ss_mask(i),
1048 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1049 call dyn_ssbond_ene(i,j,evdwij)
1051 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1052 & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1053 C triple bond artifac removal
1054 do k=j+1,iend(i,iint)
1055 C search over all next residues
1056 if (dyn_ss_mask(k)) then
1057 C check if they are cysteins
1058 C write(iout,*) 'k=',k
1059 call triple_ssbond_ene(i,j,k,evdwij)
1060 C call the energy function that removes the artifical triple disulfide
1061 C bond the soubroutine is located in ssMD.F
1063 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1064 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1065 endif!dyn_ss_mask(k)
1069 itypj=iabs(itype(j))
1070 if (itypj.eq.ntyp1) cycle
1071 dscj_inv=vbld_inv(j+nres)
1072 sig0ij=sigma(itypi,itypj)
1073 chi1=chi(itypi,itypj)
1074 chi2=chi(itypj,itypi)
1081 alf12=0.5D0*(alf1+alf2)
1082 C For diagnostics only!!!
1095 C returning jth atom to box
1097 if (xj.lt.0) xj=xj+boxxsize
1099 if (yj.lt.0) yj=yj+boxysize
1101 if (zj.lt.0) zj=zj+boxzsize
1102 if ((zj.gt.bordlipbot)
1103 &.and.(zj.lt.bordliptop)) then
1104 C the energy transfer exist
1105 if (zj.lt.buflipbot) then
1106 C what fraction I am in
1108 & ((zj-bordlipbot)/lipbufthick)
1109 C lipbufthick is thickenes of lipid buffore
1110 sslipj=sscalelip(fracinbuf)
1111 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1112 elseif (zj.gt.bufliptop) then
1113 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1114 sslipj=sscalelip(fracinbuf)
1115 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1124 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1125 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1126 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1127 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1128 C if (aa.ne.aa_aq(itypi,itypj)) then
1130 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1131 C & bb_aq(itypi,itypj)-bb,
1135 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1136 C checking the distance
1137 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1142 C finding the closest
1146 xj=xj_safe+xshift*boxxsize
1147 yj=yj_safe+yshift*boxysize
1148 zj=zj_safe+zshift*boxzsize
1149 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1150 if(dist_temp.lt.dist_init) then
1160 if (subchap.eq.1) then
1170 dxj=dc_norm(1,nres+j)
1171 dyj=dc_norm(2,nres+j)
1172 dzj=dc_norm(3,nres+j)
1173 c write (iout,*) i,j,xj,yj,zj
1174 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1176 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1177 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1178 if (sss.le.0.0) cycle
1179 C Calculate angle-dependent terms of energy and contributions to their
1184 sig=sig0ij*dsqrt(sigsq)
1185 rij_shift=1.0D0/rij-sig+sig0ij
1186 C I hate to put IF's in the loops, but here don't have another choice!!!!
1187 if (rij_shift.le.0.0D0) then
1192 c---------------------------------------------------------------
1193 rij_shift=1.0D0/rij_shift
1194 fac=rij_shift**expon
1197 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1198 eps2der=evdwij*eps3rt
1199 eps3der=evdwij*eps2rt
1200 evdwij=evdwij*eps2rt*eps3rt
1202 evdw=evdw+evdwij*sss
1204 evdw_t=evdw_t+evdwij*sss
1206 ij=icant(itypi,itypj)
1207 aux=eps1*eps2rt**2*eps3rt**2
1208 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1209 & /dabs(eps(itypi,itypj))
1210 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1211 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1212 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1213 c & aux*e2/eps(itypi,itypj)
1215 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1219 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1220 & restyp(itypi),i,restyp(itypj),j,
1221 & epsi,sigm,chi1,chi2,chip1,chip2,
1222 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1223 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1225 write (iout,*) "partial sum", evdw, evdw_t
1229 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1232 C Calculate gradient components.
1233 e1=e1*eps1*eps2rt**2*eps3rt**2
1234 fac=-expon*(e1+evdwij)*rij_shift
1237 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1238 C Calculate the radial part of the gradient
1242 C Calculate angular part of the gradient.
1245 C write(iout,*) "partial sum", evdw, evdw_t
1252 C-----------------------------------------------------------------------------
1253 subroutine egbv(evdw,evdw_t)
1255 C This subroutine calculates the interaction energy of nonbonded side chains
1256 C assuming the Gay-Berne-Vorobjev potential of interaction.
1258 implicit real*8 (a-h,o-z)
1259 include 'DIMENSIONS'
1260 include 'DIMENSIONS.ZSCOPT'
1261 include "DIMENSIONS.COMPAR"
1262 include 'COMMON.CONTROL'
1263 include 'COMMON.GEO'
1264 include 'COMMON.VAR'
1265 include 'COMMON.LOCAL'
1266 include 'COMMON.CHAIN'
1267 include 'COMMON.DERIV'
1268 include 'COMMON.NAMES'
1269 include 'COMMON.INTERACT'
1270 include 'COMMON.ENEPS'
1271 include 'COMMON.IOUNITS'
1272 include 'COMMON.CALC'
1273 include 'COMMON.SBRIDGE'
1274 common /srutu/ icall
1280 eneps_temp(j,i)=0.0d0
1285 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1288 c if (icall.gt.0) lprn=.true.
1290 do i=iatsc_s,iatsc_e
1291 itypi=iabs(itype(i))
1292 if (itypi.eq.ntyp1) cycle
1293 itypi1=iabs(itype(i+1))
1297 C returning the ith atom to box
1299 if (xi.lt.0) xi=xi+boxxsize
1301 if (yi.lt.0) yi=yi+boxysize
1303 if (zi.lt.0) zi=zi+boxzsize
1304 if ((zi.gt.bordlipbot)
1305 & .and.(zi.lt.bordliptop)) then
1306 C the energy transfer exist
1307 if (zi.lt.buflipbot) then
1308 C what fraction I am in
1310 & ((zi-bordlipbot)/lipbufthick)
1311 C lipbufthick is thickenes of lipid buffore
1312 sslipi=sscalelip(fracinbuf)
1313 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1314 elseif (zi.gt.bufliptop) then
1315 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1316 sslipi=sscalelip(fracinbuf)
1317 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1326 dxi=dc_norm(1,nres+i)
1327 dyi=dc_norm(2,nres+i)
1328 dzi=dc_norm(3,nres+i)
1329 dsci_inv=vbld_inv(i+nres)
1330 dxi=dc_norm(1,nres+i)
1331 dyi=dc_norm(2,nres+i)
1332 dzi=dc_norm(3,nres+i)
1333 dsci_inv=vbld_inv(i+nres)
1335 C Calculate SC interaction energy.
1337 do iint=1,nint_gr(i)
1338 do j=istart(i,iint),iend(i,iint)
1339 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1340 call dyn_ssbond_ene(i,j,evdwij)
1342 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1343 & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1344 C triple bond artifac removal
1345 do k=j+1,iend(i,iint)
1346 C search over all next residues
1347 if (dyn_ss_mask(k)) then
1348 C check if they are cysteins
1349 C write(iout,*) 'k=',k
1350 call triple_ssbond_ene(i,j,k,evdwij)
1351 C call the energy function that removes the artifical triple disulfide
1352 C bond the soubroutine is located in ssMD.F
1354 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1355 & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1356 endif!dyn_ss_mask(k)
1360 itypj=iabs(itype(j))
1361 if (itypj.eq.ntyp1) cycle
1362 dscj_inv=vbld_inv(j+nres)
1363 sig0ij=sigma(itypi,itypj)
1364 r0ij=r0(itypi,itypj)
1365 chi1=chi(itypi,itypj)
1366 chi2=chi(itypj,itypi)
1373 alf12=0.5D0*(alf1+alf2)
1374 C For diagnostics only!!!
1387 C returning jth atom to box
1389 if (xj.lt.0) xj=xj+boxxsize
1391 if (yj.lt.0) yj=yj+boxysize
1393 if (zj.lt.0) zj=zj+boxzsize
1394 if ((zj.gt.bordlipbot)
1395 & .and.(zj.lt.bordliptop)) then
1396 C the energy transfer exist
1397 if (zj.lt.buflipbot) then
1398 C what fraction I am in
1400 & ((zj-bordlipbot)/lipbufthick)
1401 C lipbufthick is thickenes of lipid buffore
1402 sslipj=sscalelip(fracinbuf)
1403 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1404 elseif (zj.gt.bufliptop) then
1405 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1406 sslipj=sscalelip(fracinbuf)
1407 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1416 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1417 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1418 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1419 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1420 C if (aa.ne.aa_aq(itypi,itypj)) then
1422 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1423 C & bb_aq(itypi,itypj)-bb,
1427 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1428 C checking the distance
1429 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1434 C finding the closest
1438 xj=xj_safe+xshift*boxxsize
1439 yj=yj_safe+yshift*boxysize
1440 zj=zj_safe+zshift*boxzsize
1441 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1442 if (dist_temp.lt.dist_init) then
1452 if (subchap.eq.1) then
1462 dxj=dc_norm(1,nres+j)
1463 dyj=dc_norm(2,nres+j)
1464 dzj=dc_norm(3,nres+j)
1465 c write (iout,*) i,j,xj,yj,zj
1466 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1468 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1469 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1470 if (sss.le.0.0) cycle
1471 C Calculate angle-dependent terms of energy and contributions to their
1476 sig=sig0ij*dsqrt(sigsq)
1477 rij_shift=1.0D0/rij-sig+r0ij
1478 C I hate to put IF's in the loops, but here don't have another choice!!!!
1479 if (rij_shift.le.0.0D0) then
1484 c---------------------------------------------------------------
1485 rij_shift=1.0D0/rij_shift
1486 fac=rij_shift**expon
1489 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1490 eps2der=evdwij*eps3rt
1491 eps3der=evdwij*eps2rt
1492 fac_augm=rrij**expon
1493 e_augm=augm(itypi,itypj)*fac_augm
1494 evdwij=evdwij*eps2rt*eps3rt
1496 evdw=evdw+evdwij*sss+e_augm
1498 evdw_t=evdw_t+evdwij*sss+e_augm
1500 c evdw=evdw+evdwij+e_augm
1501 ij=icant(itypi,itypj)
1502 aux=eps1*eps2rt**2*eps3rt**2
1503 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1504 & /dabs(eps(itypi,itypj))
1505 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1506 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1507 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1508 c & aux*e2/eps(itypi,itypj)
1512 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1514 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1515 & restyp(itypi),i,restyp(itypj),j,
1516 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1517 & chi1,chi2,chip1,chip2,
1518 & eps1,eps2rt**2,eps3rt**2,
1519 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1521 write (iout,*) "partial sum", evdw, evdw_t
1525 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1528 C Calculate gradient components.
1529 e1=e1*eps1*eps2rt**2*eps3rt**2
1530 fac=-expon*(e1+evdwij)*rij_shift
1533 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1534 C Calculate the radial part of the gradient
1538 C Calculate angular part of the gradient.
1547 C-----------------------------------------------------------------------------
1548 subroutine sc_angular
1549 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1550 C om12. Called by ebp, egb, and egbv.
1552 include 'COMMON.CALC'
1556 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1557 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1558 om12=dxi*dxj+dyi*dyj+dzi*dzj
1560 C Calculate eps1(om12) and its derivative in om12
1561 faceps1=1.0D0-om12*chiom12
1562 faceps1_inv=1.0D0/faceps1
1563 eps1=dsqrt(faceps1_inv)
1564 C Following variable is eps1*deps1/dom12
1565 eps1_om12=faceps1_inv*chiom12
1566 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1571 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1572 sigsq=1.0D0-facsig*faceps1_inv
1573 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1574 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1575 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1576 C Calculate eps2 and its derivatives in om1, om2, and om12.
1579 chipom12=chip12*om12
1580 facp=1.0D0-om12*chipom12
1582 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1583 C Following variable is the square root of eps2
1584 eps2rt=1.0D0-facp1*facp_inv
1585 C Following three variables are the derivatives of the square root of eps
1586 C in om1, om2, and om12.
1587 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1588 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1589 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1590 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1591 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1592 C Calculate whole angle-dependent part of epsilon and contributions
1593 C to its derivatives
1596 C----------------------------------------------------------------------------
1598 implicit real*8 (a-h,o-z)
1599 include 'DIMENSIONS'
1600 include 'DIMENSIONS.ZSCOPT'
1601 include 'COMMON.CHAIN'
1602 include 'COMMON.DERIV'
1603 include 'COMMON.CALC'
1604 double precision dcosom1(3),dcosom2(3)
1605 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1606 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1607 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1608 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1610 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1611 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1614 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1617 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1618 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1619 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1620 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1621 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1622 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1625 C Calculate the components of the gradient in DC and X
1629 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1634 c------------------------------------------------------------------------------
1635 subroutine vec_and_deriv
1636 implicit real*8 (a-h,o-z)
1637 include 'DIMENSIONS'
1638 include 'DIMENSIONS.ZSCOPT'
1639 include 'COMMON.IOUNITS'
1640 include 'COMMON.GEO'
1641 include 'COMMON.VAR'
1642 include 'COMMON.LOCAL'
1643 include 'COMMON.CHAIN'
1644 include 'COMMON.VECTORS'
1645 include 'COMMON.DERIV'
1646 include 'COMMON.INTERACT'
1647 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1648 C Compute the local reference systems. For reference system (i), the
1649 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1650 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1652 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1653 if (i.eq.nres-1) then
1654 C Case of the last full residue
1655 C Compute the Z-axis
1656 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1657 costh=dcos(pi-theta(nres))
1658 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1659 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1665 C Compute the derivatives of uz
1667 uzder(2,1,1)=-dc_norm(3,i-1)
1668 uzder(3,1,1)= dc_norm(2,i-1)
1669 uzder(1,2,1)= dc_norm(3,i-1)
1671 uzder(3,2,1)=-dc_norm(1,i-1)
1672 uzder(1,3,1)=-dc_norm(2,i-1)
1673 uzder(2,3,1)= dc_norm(1,i-1)
1676 uzder(2,1,2)= dc_norm(3,i)
1677 uzder(3,1,2)=-dc_norm(2,i)
1678 uzder(1,2,2)=-dc_norm(3,i)
1680 uzder(3,2,2)= dc_norm(1,i)
1681 uzder(1,3,2)= dc_norm(2,i)
1682 uzder(2,3,2)=-dc_norm(1,i)
1685 C Compute the Y-axis
1688 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1691 C Compute the derivatives of uy
1694 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1695 & -dc_norm(k,i)*dc_norm(j,i-1)
1696 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1698 uyder(j,j,1)=uyder(j,j,1)-costh
1699 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1704 uygrad(l,k,j,i)=uyder(l,k,j)
1705 uzgrad(l,k,j,i)=uzder(l,k,j)
1709 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1710 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1711 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1712 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1716 C Compute the Z-axis
1717 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1718 costh=dcos(pi-theta(i+2))
1719 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1724 C Compute the derivatives of uz
1726 uzder(2,1,1)=-dc_norm(3,i+1)
1727 uzder(3,1,1)= dc_norm(2,i+1)
1728 uzder(1,2,1)= dc_norm(3,i+1)
1730 uzder(3,2,1)=-dc_norm(1,i+1)
1731 uzder(1,3,1)=-dc_norm(2,i+1)
1732 uzder(2,3,1)= dc_norm(1,i+1)
1735 uzder(2,1,2)= dc_norm(3,i)
1736 uzder(3,1,2)=-dc_norm(2,i)
1737 uzder(1,2,2)=-dc_norm(3,i)
1739 uzder(3,2,2)= dc_norm(1,i)
1740 uzder(1,3,2)= dc_norm(2,i)
1741 uzder(2,3,2)=-dc_norm(1,i)
1744 C Compute the Y-axis
1747 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1750 C Compute the derivatives of uy
1753 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1754 & -dc_norm(k,i)*dc_norm(j,i+1)
1755 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1757 uyder(j,j,1)=uyder(j,j,1)-costh
1758 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1763 uygrad(l,k,j,i)=uyder(l,k,j)
1764 uzgrad(l,k,j,i)=uzder(l,k,j)
1768 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1769 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1770 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1771 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1777 vbld_inv_temp(1)=vbld_inv(i+1)
1778 if (i.lt.nres-1) then
1779 vbld_inv_temp(2)=vbld_inv(i+2)
1781 vbld_inv_temp(2)=vbld_inv(i)
1786 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1787 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1795 C--------------------------------------------------------------------------
1796 subroutine set_matrices
1797 implicit real*8 (a-h,o-z)
1798 include 'DIMENSIONS'
1802 integer status(MPI_STATUS_SIZE)
1804 include 'DIMENSIONS.ZSCOPT'
1805 include 'COMMON.IOUNITS'
1806 include 'COMMON.GEO'
1807 include 'COMMON.VAR'
1808 include 'COMMON.LOCAL'
1809 include 'COMMON.CHAIN'
1810 include 'COMMON.DERIV'
1811 include 'COMMON.INTERACT'
1812 include 'COMMON.CONTACTS'
1813 include 'COMMON.TORSION'
1814 include 'COMMON.VECTORS'
1815 include 'COMMON.FFIELD'
1816 double precision auxvec(2),auxmat(2,2)
1818 C Compute the virtual-bond-torsional-angle dependent quantities needed
1819 C to calculate the el-loc multibody terms of various order.
1821 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1823 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1824 iti = itype2loc(itype(i-2))
1828 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1829 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1830 iti1 = itype2loc(itype(i-1))
1835 cost1=dcos(theta(i-1))
1836 sint1=dsin(theta(i-1))
1838 sint1cub=sint1sq*sint1
1839 sint1cost1=2*sint1*cost1
1841 write (iout,*) "bnew1",i,iti
1842 write (iout,*) (bnew1(k,1,iti),k=1,3)
1843 write (iout,*) (bnew1(k,2,iti),k=1,3)
1844 write (iout,*) "bnew2",i,iti
1845 write (iout,*) (bnew2(k,1,iti),k=1,3)
1846 write (iout,*) (bnew2(k,2,iti),k=1,3)
1849 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1851 gtb1(k,i-2)=cost1*b1k-sint1sq*
1852 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1853 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1855 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1856 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1859 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1860 cc(1,k,i-2)=sint1sq*aux
1861 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1862 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1863 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1864 dd(1,k,i-2)=sint1sq*aux
1865 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1866 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1868 cc(2,1,i-2)=cc(1,2,i-2)
1869 cc(2,2,i-2)=-cc(1,1,i-2)
1870 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1871 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1872 dd(2,1,i-2)=dd(1,2,i-2)
1873 dd(2,2,i-2)=-dd(1,1,i-2)
1874 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1875 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1878 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1879 EE(l,k,i-2)=sint1sq*aux
1881 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1884 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1885 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1886 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1887 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1889 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1890 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1891 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1893 c b1tilde(1,i-2)=b1(1,i-2)
1894 c b1tilde(2,i-2)=-b1(2,i-2)
1895 c b2tilde(1,i-2)=b2(1,i-2)
1896 c b2tilde(2,i-2)=-b2(2,i-2)
1898 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1899 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1900 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1901 write (iout,*) 'theta=', theta(i-1)
1904 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1905 c iti = itype2loc(itype(i-2))
1909 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1910 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1911 c iti1 = itype2loc(itype(i-1))
1921 CC(k,l,i-2)=ccold(k,l,iti)
1922 DD(k,l,i-2)=ddold(k,l,iti)
1923 EE(k,l,i-2)=eeold(k,l,iti)
1927 b1tilde(1,i-2)= b1(1,i-2)
1928 b1tilde(2,i-2)=-b1(2,i-2)
1929 b2tilde(1,i-2)= b2(1,i-2)
1930 b2tilde(2,i-2)=-b2(2,i-2)
1932 Ctilde(1,1,i-2)= CC(1,1,i-2)
1933 Ctilde(1,2,i-2)= CC(1,2,i-2)
1934 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1935 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1937 Dtilde(1,1,i-2)= DD(1,1,i-2)
1938 Dtilde(1,2,i-2)= DD(1,2,i-2)
1939 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1940 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1942 write(iout,*) "i",i," iti",iti
1943 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1944 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1948 if (i .lt. nres+1) then
1985 if (i .gt. 3 .and. i .lt. nres+1) then
1986 obrot_der(1,i-2)=-sin1
1987 obrot_der(2,i-2)= cos1
1988 Ugder(1,1,i-2)= sin1
1989 Ugder(1,2,i-2)=-cos1
1990 Ugder(2,1,i-2)=-cos1
1991 Ugder(2,2,i-2)=-sin1
1994 obrot2_der(1,i-2)=-dwasin2
1995 obrot2_der(2,i-2)= dwacos2
1996 Ug2der(1,1,i-2)= dwasin2
1997 Ug2der(1,2,i-2)=-dwacos2
1998 Ug2der(2,1,i-2)=-dwacos2
1999 Ug2der(2,2,i-2)=-dwasin2
2001 obrot_der(1,i-2)=0.0d0
2002 obrot_der(2,i-2)=0.0d0
2003 Ugder(1,1,i-2)=0.0d0
2004 Ugder(1,2,i-2)=0.0d0
2005 Ugder(2,1,i-2)=0.0d0
2006 Ugder(2,2,i-2)=0.0d0
2007 obrot2_der(1,i-2)=0.0d0
2008 obrot2_der(2,i-2)=0.0d0
2009 Ug2der(1,1,i-2)=0.0d0
2010 Ug2der(1,2,i-2)=0.0d0
2011 Ug2der(2,1,i-2)=0.0d0
2012 Ug2der(2,2,i-2)=0.0d0
2014 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2015 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2016 iti = itype2loc(itype(i-2))
2020 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2021 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2022 iti1 = itype2loc(itype(i-1))
2026 cd write (iout,*) '*******i',i,' iti1',iti
2027 cd write (iout,*) 'b1',b1(:,iti)
2028 cd write (iout,*) 'b2',b2(:,iti)
2029 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2030 c if (i .gt. iatel_s+2) then
2031 if (i .gt. nnt+2) then
2032 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2034 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2035 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2037 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
2038 c & EE(1,2,iti),EE(2,2,i)
2039 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2040 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2041 c write(iout,*) "Macierz EUG",
2042 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2044 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2046 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
2047 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
2048 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2049 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
2050 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
2061 DtUg2(l,k,i-2)=0.0d0
2065 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2066 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2068 muder(k,i-2)=Ub2der(k,i-2)
2070 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2071 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2072 if (itype(i-1).le.ntyp) then
2073 iti1 = itype2loc(itype(i-1))
2081 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2084 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2085 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2086 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2087 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2088 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2089 & ((ee(l,k,i-2),l=1,2),k=1,2)
2091 cd write (iout,*) 'mu1',mu1(:,i-2)
2092 cd write (iout,*) 'mu2',mu2(:,i-2)
2093 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2096 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2097 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2098 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2099 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2100 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2102 C Vectors and matrices dependent on a single virtual-bond dihedral.
2103 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2104 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2105 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2106 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2107 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2109 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2110 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2111 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2112 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2116 C Matrices dependent on two consecutive virtual-bond dihedrals.
2117 C The order of matrices is from left to right.
2118 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2121 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2123 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2124 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2126 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2127 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2129 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2130 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2131 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2137 C--------------------------------------------------------------------------
2138 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2140 C This subroutine calculates the average interaction energy and its gradient
2141 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2142 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2143 C The potential depends both on the distance of peptide-group centers and on
2144 C the orientation of the CA-CA virtual bonds.
2146 implicit real*8 (a-h,o-z)
2150 include 'DIMENSIONS'
2151 include 'DIMENSIONS.ZSCOPT'
2152 include 'COMMON.CONTROL'
2153 include 'COMMON.IOUNITS'
2154 include 'COMMON.GEO'
2155 include 'COMMON.VAR'
2156 include 'COMMON.LOCAL'
2157 include 'COMMON.CHAIN'
2158 include 'COMMON.DERIV'
2159 include 'COMMON.INTERACT'
2160 include 'COMMON.CONTACTS'
2161 include 'COMMON.TORSION'
2162 include 'COMMON.VECTORS'
2163 include 'COMMON.FFIELD'
2164 include 'COMMON.TIME1'
2165 include 'COMMON.SPLITELE'
2166 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2167 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2168 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2169 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2170 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2171 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2173 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2175 double precision scal_el /1.0d0/
2177 double precision scal_el /0.5d0/
2180 C 13-go grudnia roku pamietnego...
2181 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2182 & 0.0d0,1.0d0,0.0d0,
2183 & 0.0d0,0.0d0,1.0d0/
2184 cd write(iout,*) 'In EELEC'
2186 cd write(iout,*) 'Type',i
2187 cd write(iout,*) 'B1',B1(:,i)
2188 cd write(iout,*) 'B2',B2(:,i)
2189 cd write(iout,*) 'CC',CC(:,:,i)
2190 cd write(iout,*) 'DD',DD(:,:,i)
2191 cd write(iout,*) 'EE',EE(:,:,i)
2193 cd call check_vecgrad
2195 if (icheckgrad.eq.1) then
2197 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2199 dc_norm(k,i)=dc(k,i)*fac
2201 c write (iout,*) 'i',i,' fac',fac
2204 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2205 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2206 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2207 c call vec_and_deriv
2213 time_mat=time_mat+MPI_Wtime()-time01
2217 cd write (iout,*) 'i=',i
2219 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2222 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2223 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2236 cd print '(a)','Enter EELEC'
2237 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2239 gel_loc_loc(i)=0.0d0
2244 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2246 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2248 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2249 do i=iturn3_start,iturn3_end
2251 C write(iout,*) "tu jest i",i
2252 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2253 C changes suggested by Ana to avoid out of bounds
2254 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2255 c & .or.((i+4).gt.nres)
2256 c & .or.((i-1).le.0)
2257 C end of changes by Ana
2258 C dobra zmiana wycofana
2259 & .or. itype(i+2).eq.ntyp1
2260 & .or. itype(i+3).eq.ntyp1) cycle
2261 C Adam: Instructions below will switch off existing interactions
2263 c if(itype(i-1).eq.ntyp1)cycle
2265 c if(i.LT.nres-3)then
2266 c if (itype(i+4).eq.ntyp1) cycle
2271 dx_normi=dc_norm(1,i)
2272 dy_normi=dc_norm(2,i)
2273 dz_normi=dc_norm(3,i)
2274 xmedi=c(1,i)+0.5d0*dxi
2275 ymedi=c(2,i)+0.5d0*dyi
2276 zmedi=c(3,i)+0.5d0*dzi
2277 xmedi=mod(xmedi,boxxsize)
2278 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2279 ymedi=mod(ymedi,boxysize)
2280 if (ymedi.lt.0) ymedi=ymedi+boxysize
2281 zmedi=mod(zmedi,boxzsize)
2282 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2284 call eelecij(i,i+2,ees,evdw1,eel_loc)
2285 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2286 num_cont_hb(i)=num_conti
2288 do i=iturn4_start,iturn4_end
2290 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2291 C changes suggested by Ana to avoid out of bounds
2292 c & .or.((i+5).gt.nres)
2293 c & .or.((i-1).le.0)
2294 C end of changes suggested by Ana
2295 & .or. itype(i+3).eq.ntyp1
2296 & .or. itype(i+4).eq.ntyp1
2297 c & .or. itype(i+5).eq.ntyp1
2298 c & .or. itype(i).eq.ntyp1
2299 c & .or. itype(i-1).eq.ntyp1
2304 dx_normi=dc_norm(1,i)
2305 dy_normi=dc_norm(2,i)
2306 dz_normi=dc_norm(3,i)
2307 xmedi=c(1,i)+0.5d0*dxi
2308 ymedi=c(2,i)+0.5d0*dyi
2309 zmedi=c(3,i)+0.5d0*dzi
2310 C Return atom into box, boxxsize is size of box in x dimension
2312 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2313 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2314 C Condition for being inside the proper box
2315 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2316 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2320 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2321 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2322 C Condition for being inside the proper box
2323 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2324 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2328 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2329 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2330 C Condition for being inside the proper box
2331 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2332 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2335 xmedi=mod(xmedi,boxxsize)
2336 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2337 ymedi=mod(ymedi,boxysize)
2338 if (ymedi.lt.0) ymedi=ymedi+boxysize
2339 zmedi=mod(zmedi,boxzsize)
2340 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2342 num_conti=num_cont_hb(i)
2343 c write(iout,*) "JESTEM W PETLI"
2344 call eelecij(i,i+3,ees,evdw1,eel_loc)
2345 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2346 & call eturn4(i,eello_turn4)
2347 num_cont_hb(i)=num_conti
2349 C Loop over all neighbouring boxes
2354 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2357 do i=iatel_s,iatel_e
2360 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2361 C changes suggested by Ana to avoid out of bounds
2362 c & .or.((i+2).gt.nres)
2363 c & .or.((i-1).le.0)
2364 C end of changes by Ana
2365 c & .or. itype(i+2).eq.ntyp1
2366 c & .or. itype(i-1).eq.ntyp1
2371 dx_normi=dc_norm(1,i)
2372 dy_normi=dc_norm(2,i)
2373 dz_normi=dc_norm(3,i)
2374 xmedi=c(1,i)+0.5d0*dxi
2375 ymedi=c(2,i)+0.5d0*dyi
2376 zmedi=c(3,i)+0.5d0*dzi
2377 xmedi=mod(xmedi,boxxsize)
2378 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2379 ymedi=mod(ymedi,boxysize)
2380 if (ymedi.lt.0) ymedi=ymedi+boxysize
2381 zmedi=mod(zmedi,boxzsize)
2382 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2383 C xmedi=xmedi+xshift*boxxsize
2384 C ymedi=ymedi+yshift*boxysize
2385 C zmedi=zmedi+zshift*boxzsize
2387 C Return tom into box, boxxsize is size of box in x dimension
2389 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2390 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2391 C Condition for being inside the proper box
2392 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2393 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2397 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2398 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2399 C Condition for being inside the proper box
2400 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2401 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2405 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2406 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2407 cC Condition for being inside the proper box
2408 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2409 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2413 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2414 num_conti=num_cont_hb(i)
2416 do j=ielstart(i),ielend(i)
2418 C write (iout,*) i,j
2420 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2421 C changes suggested by Ana to avoid out of bounds
2422 c & .or.((j+2).gt.nres)
2423 c & .or.((j-1).le.0)
2424 C end of changes by Ana
2425 c & .or.itype(j+2).eq.ntyp1
2426 c & .or.itype(j-1).eq.ntyp1
2428 call eelecij(i,j,ees,evdw1,eel_loc)
2430 num_cont_hb(i)=num_conti
2436 c write (iout,*) "Number of loop steps in EELEC:",ind
2438 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2439 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2441 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2442 ccc eel_loc=eel_loc+eello_turn3
2443 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2446 C-------------------------------------------------------------------------------
2447 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2448 implicit real*8 (a-h,o-z)
2449 include 'DIMENSIONS'
2450 include 'DIMENSIONS.ZSCOPT'
2454 include 'COMMON.CONTROL'
2455 include 'COMMON.IOUNITS'
2456 include 'COMMON.GEO'
2457 include 'COMMON.VAR'
2458 include 'COMMON.LOCAL'
2459 include 'COMMON.CHAIN'
2460 include 'COMMON.DERIV'
2461 include 'COMMON.INTERACT'
2462 include 'COMMON.CONTACTS'
2463 include 'COMMON.TORSION'
2464 include 'COMMON.VECTORS'
2465 include 'COMMON.FFIELD'
2466 include 'COMMON.TIME1'
2467 include 'COMMON.SPLITELE'
2468 include 'COMMON.SHIELD'
2469 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2470 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2471 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2472 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2473 & gmuij2(4),gmuji2(4)
2474 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2475 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2477 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2479 double precision scal_el /1.0d0/
2481 double precision scal_el /0.5d0/
2484 C 13-go grudnia roku pamietnego...
2485 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2486 & 0.0d0,1.0d0,0.0d0,
2487 & 0.0d0,0.0d0,1.0d0/
2488 integer xshift,yshift,zshift
2489 c time00=MPI_Wtime()
2490 cd write (iout,*) "eelecij",i,j
2494 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2495 aaa=app(iteli,itelj)
2496 bbb=bpp(iteli,itelj)
2497 ael6i=ael6(iteli,itelj)
2498 ael3i=ael3(iteli,itelj)
2502 dx_normj=dc_norm(1,j)
2503 dy_normj=dc_norm(2,j)
2504 dz_normj=dc_norm(3,j)
2505 C xj=c(1,j)+0.5D0*dxj-xmedi
2506 C yj=c(2,j)+0.5D0*dyj-ymedi
2507 C zj=c(3,j)+0.5D0*dzj-zmedi
2512 if (xj.lt.0) xj=xj+boxxsize
2514 if (yj.lt.0) yj=yj+boxysize
2516 if (zj.lt.0) zj=zj+boxzsize
2517 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2518 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2526 xj=xj_safe+xshift*boxxsize
2527 yj=yj_safe+yshift*boxysize
2528 zj=zj_safe+zshift*boxzsize
2529 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2530 if(dist_temp.lt.dist_init) then
2540 if (isubchap.eq.1) then
2549 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2551 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2552 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2553 C Condition for being inside the proper box
2554 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2555 c & (xj.lt.((-0.5d0)*boxxsize))) then
2559 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2560 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2561 C Condition for being inside the proper box
2562 c if ((yj.gt.((0.5d0)*boxysize)).or.
2563 c & (yj.lt.((-0.5d0)*boxysize))) then
2567 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2568 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2569 C Condition for being inside the proper box
2570 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2571 c & (zj.lt.((-0.5d0)*boxzsize))) then
2574 C endif !endPBC condintion
2578 rij=xj*xj+yj*yj+zj*zj
2580 sss=sscale(sqrt(rij))
2581 sssgrad=sscagrad(sqrt(rij))
2582 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2583 c & " rlamb",rlamb," sss",sss
2584 c if (sss.gt.0.0d0) then
2590 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2591 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2592 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2593 fac=cosa-3.0D0*cosb*cosg
2595 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2596 if (j.eq.i+2) ev1=scal_el*ev1
2601 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2605 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2606 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2607 if (shield_mode.gt.0) then
2610 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2611 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2620 evdw1=evdw1+evdwij*sss
2621 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2622 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2623 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2624 cd & xmedi,ymedi,zmedi,xj,yj,zj
2626 if (energy_dec) then
2627 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2629 &,iteli,itelj,aaa,evdw1,sss
2630 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2631 &fac_shield(i),fac_shield(j)
2635 C Calculate contributions to the Cartesian gradient.
2638 facvdw=-6*rrmij*(ev1+evdwij)*sss
2639 facel=-3*rrmij*(el1+eesij)
2646 * Radial derivatives. First process both termini of the fragment (i,j)
2652 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2653 & (shield_mode.gt.0)) then
2655 do ilist=1,ishield_list(i)
2656 iresshield=shield_list(ilist,i)
2658 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2660 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2662 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2663 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2664 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2665 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2666 C if (iresshield.gt.i) then
2667 C do ishi=i+1,iresshield-1
2668 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2669 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2673 C do ishi=iresshield,i
2674 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2675 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2681 do ilist=1,ishield_list(j)
2682 iresshield=shield_list(ilist,j)
2684 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2686 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2688 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2689 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2691 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2692 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2693 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2694 C if (iresshield.gt.j) then
2695 C do ishi=j+1,iresshield-1
2696 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2697 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2701 C do ishi=iresshield,j
2702 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2703 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2710 gshieldc(k,i)=gshieldc(k,i)+
2711 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2712 gshieldc(k,j)=gshieldc(k,j)+
2713 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2714 gshieldc(k,i-1)=gshieldc(k,i-1)+
2715 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2716 gshieldc(k,j-1)=gshieldc(k,j-1)+
2717 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2722 c ghalf=0.5D0*ggg(k)
2723 c gelc(k,i)=gelc(k,i)+ghalf
2724 c gelc(k,j)=gelc(k,j)+ghalf
2726 c 9/28/08 AL Gradient compotents will be summed only at the end
2727 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2729 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2730 C & +grad_shield(k,j)*eesij/fac_shield(j)
2731 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2732 C & +grad_shield(k,i)*eesij/fac_shield(i)
2733 C gelc_long(k,i-1)=gelc_long(k,i-1)
2734 C & +grad_shield(k,i)*eesij/fac_shield(i)
2735 C gelc_long(k,j-1)=gelc_long(k,j-1)
2736 C & +grad_shield(k,j)*eesij/fac_shield(j)
2738 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2741 * Loop over residues i+1 thru j-1.
2745 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2748 if (sss.gt.0.0) then
2749 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2750 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2751 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2758 c ghalf=0.5D0*ggg(k)
2759 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2760 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2762 c 9/28/08 AL Gradient compotents will be summed only at the end
2764 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2765 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2768 * Loop over residues i+1 thru j-1.
2772 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2778 facvdw=(ev1+evdwij)*sss
2781 fac=-3*rrmij*(facvdw+facvdw+facel)
2786 * Radial derivatives. First process both termini of the fragment (i,j)
2790 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2792 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2794 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2796 c ghalf=0.5D0*ggg(k)
2797 c gelc(k,i)=gelc(k,i)+ghalf
2798 c gelc(k,j)=gelc(k,j)+ghalf
2800 c 9/28/08 AL Gradient compotents will be summed only at the end
2802 gelc_long(k,j)=gelc(k,j)+ggg(k)
2803 gelc_long(k,i)=gelc(k,i)-ggg(k)
2806 * Loop over residues i+1 thru j-1.
2810 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2813 c 9/28/08 AL Gradient compotents will be summed only at the end
2814 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2815 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2816 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2818 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2819 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2827 ecosa=2.0D0*fac3*fac1+fac4
2830 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2831 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2833 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2834 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2836 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2837 cd & (dcosg(k),k=1,3)
2839 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2840 & fac_shield(i)**2*fac_shield(j)**2
2843 c ghalf=0.5D0*ggg(k)
2844 c gelc(k,i)=gelc(k,i)+ghalf
2845 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2846 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2847 c gelc(k,j)=gelc(k,j)+ghalf
2848 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2849 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2853 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2856 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2859 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2860 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2861 & *fac_shield(i)**2*fac_shield(j)**2
2863 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2864 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2865 & *fac_shield(i)**2*fac_shield(j)**2
2866 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2867 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2869 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2874 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2875 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2876 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2878 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2879 C energy of a peptide unit is assumed in the form of a second-order
2880 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2881 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2882 C are computed for EVERY pair of non-contiguous peptide groups.
2885 if (j.lt.nres-1) then
2897 muij(kkk)=mu(k,i)*mu(l,j)
2898 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2901 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2902 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2903 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2904 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2905 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2906 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2912 write (iout,*) 'EELEC: i',i,' j',j
2913 write (iout,*) 'j',j,' j1',j1,' j2',j2
2914 write(iout,*) 'muij',muij
2915 write (iout,*) "uy",uy(:,i)
2916 write (iout,*) "uz",uz(:,j)
2917 write (iout,*) "erij",erij
2919 ury=scalar(uy(1,i),erij)
2920 urz=scalar(uz(1,i),erij)
2921 vry=scalar(uy(1,j),erij)
2922 vrz=scalar(uz(1,j),erij)
2923 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2924 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2925 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2926 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2927 fac=dsqrt(-ael6i)*r3ij
2932 cd write (iout,'(4i5,4f10.5)')
2933 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2934 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2935 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2936 cd & uy(:,j),uz(:,j)
2937 cd write (iout,'(4f10.5)')
2938 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2939 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2940 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2941 cd write (iout,'(9f10.5/)')
2942 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2943 C Derivatives of the elements of A in virtual-bond vectors
2945 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2947 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2948 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2949 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2950 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2951 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2952 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2953 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2954 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2955 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2956 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2957 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2958 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2960 C Compute radial contributions to the gradient
2978 C Add the contributions coming from er
2981 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2982 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2983 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2984 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2987 C Derivatives in DC(i)
2988 cgrad ghalf1=0.5d0*agg(k,1)
2989 cgrad ghalf2=0.5d0*agg(k,2)
2990 cgrad ghalf3=0.5d0*agg(k,3)
2991 cgrad ghalf4=0.5d0*agg(k,4)
2992 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2993 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2994 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2995 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2996 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2997 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2998 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2999 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3000 C Derivatives in DC(i+1)
3001 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3002 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3003 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3004 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3005 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3006 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3007 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3008 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3009 C Derivatives in DC(j)
3010 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3011 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3012 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3013 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3014 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3015 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3016 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3017 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3018 C Derivatives in DC(j+1) or DC(nres-1)
3019 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3020 & -3.0d0*vryg(k,3)*ury)
3021 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3022 & -3.0d0*vrzg(k,3)*ury)
3023 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3024 & -3.0d0*vryg(k,3)*urz)
3025 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3026 & -3.0d0*vrzg(k,3)*urz)
3027 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3029 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3044 aggi(k,l)=-aggi(k,l)
3045 aggi1(k,l)=-aggi1(k,l)
3046 aggj(k,l)=-aggj(k,l)
3047 aggj1(k,l)=-aggj1(k,l)
3051 if (j.lt.nres-1) then
3057 aggi(k,l)=-aggi(k,l)
3058 aggi1(k,l)=-aggi1(k,l)
3059 aggj(k,l)=-aggj(k,l)
3060 aggj1(k,l)=-aggj1(k,l)
3071 aggi(k,l)=-aggi(k,l)
3072 aggi1(k,l)=-aggi1(k,l)
3073 aggj(k,l)=-aggj(k,l)
3074 aggj1(k,l)=-aggj1(k,l)
3079 IF (wel_loc.gt.0.0d0) THEN
3080 C Contribution to the local-electrostatic energy coming from the i-j pair
3081 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3084 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
3086 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
3087 & " wel_loc",wel_loc
3089 if (shield_mode.eq.0) then
3096 eel_loc_ij=eel_loc_ij
3097 & *fac_shield(i)*fac_shield(j)
3098 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3099 & 'eelloc',i,j,eel_loc_ij
3100 c if (eel_loc_ij.ne.0)
3101 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3102 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3104 eel_loc=eel_loc+eel_loc_ij
3105 C Now derivative over eel_loc
3107 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3108 & (shield_mode.gt.0)) then
3111 do ilist=1,ishield_list(i)
3112 iresshield=shield_list(ilist,i)
3114 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
3117 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3119 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
3120 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3124 do ilist=1,ishield_list(j)
3125 iresshield=shield_list(ilist,j)
3127 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
3130 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3132 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3133 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3140 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3141 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3142 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3143 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3144 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3145 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3146 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3147 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3152 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3153 c & ' eel_loc_ij',eel_loc_ij
3154 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3155 C Calculate patrial derivative for theta angle
3157 geel_loc_ij=(a22*gmuij1(1)
3161 & *fac_shield(i)*fac_shield(j)
3162 c write(iout,*) "derivative over thatai"
3163 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3165 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3166 & geel_loc_ij*wel_loc
3167 c write(iout,*) "derivative over thatai-1"
3168 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3175 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3176 & geel_loc_ij*wel_loc
3177 & *fac_shield(i)*fac_shield(j)
3179 c Derivative over j residue
3180 geel_loc_ji=a22*gmuji1(1)
3184 c write(iout,*) "derivative over thataj"
3185 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3188 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3189 & geel_loc_ji*wel_loc
3190 & *fac_shield(i)*fac_shield(j)
3197 c write(iout,*) "derivative over thataj-1"
3198 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3200 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3201 & geel_loc_ji*wel_loc
3202 & *fac_shield(i)*fac_shield(j)
3204 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3206 C Partial derivatives in virtual-bond dihedral angles gamma
3208 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3209 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3210 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3211 & *fac_shield(i)*fac_shield(j)
3213 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3214 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3215 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3216 & *fac_shield(i)*fac_shield(j)
3217 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3219 ggg(l)=(agg(l,1)*muij(1)+
3220 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3221 & *fac_shield(i)*fac_shield(j)
3222 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3223 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3224 cgrad ghalf=0.5d0*ggg(l)
3225 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3226 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3230 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3233 C Remaining derivatives of eello
3235 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3236 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3237 & *fac_shield(i)*fac_shield(j)
3239 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3240 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3241 & *fac_shield(i)*fac_shield(j)
3243 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3244 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3245 & *fac_shield(i)*fac_shield(j)
3247 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3248 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3249 & *fac_shield(i)*fac_shield(j)
3256 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3257 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3258 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3259 & .and. num_conti.le.maxconts) then
3260 c write (iout,*) i,j," entered corr"
3262 C Calculate the contact function. The ith column of the array JCONT will
3263 C contain the numbers of atoms that make contacts with the atom I (of numbers
3264 C greater than I). The arrays FACONT and GACONT will contain the values of
3265 C the contact function and its derivative.
3266 c r0ij=1.02D0*rpp(iteli,itelj)
3267 c r0ij=1.11D0*rpp(iteli,itelj)
3268 r0ij=2.20D0*rpp(iteli,itelj)
3269 c r0ij=1.55D0*rpp(iteli,itelj)
3270 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3271 if (fcont.gt.0.0D0) then
3272 num_conti=num_conti+1
3273 if (num_conti.gt.maxconts) then
3274 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3275 & ' will skip next contacts for this conf.'
3277 jcont_hb(num_conti,i)=j
3278 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3279 cd & " jcont_hb",jcont_hb(num_conti,i)
3280 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3281 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3282 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3284 d_cont(num_conti,i)=rij
3285 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3286 C --- Electrostatic-interaction matrix ---
3287 a_chuj(1,1,num_conti,i)=a22
3288 a_chuj(1,2,num_conti,i)=a23
3289 a_chuj(2,1,num_conti,i)=a32
3290 a_chuj(2,2,num_conti,i)=a33
3291 C --- Gradient of rij
3294 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3301 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3302 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3303 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3304 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3305 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3311 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3312 C Calculate contact energies
3314 wij=cosa-3.0D0*cosb*cosg
3317 c fac3=dsqrt(-ael6i)/r0ij**3
3318 fac3=dsqrt(-ael6i)*r3ij
3319 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3320 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3321 if (ees0tmp.gt.0) then
3322 ees0pij=dsqrt(ees0tmp)
3326 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3327 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3328 if (ees0tmp.gt.0) then
3329 ees0mij=dsqrt(ees0tmp)
3334 if (shield_mode.eq.0) then
3338 ees0plist(num_conti,i)=j
3339 C fac_shield(i)=0.4d0
3340 C fac_shield(j)=0.6d0
3342 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3343 & *fac_shield(i)*fac_shield(j)
3344 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3345 & *fac_shield(i)*fac_shield(j)
3346 C Diagnostics. Comment out or remove after debugging!
3347 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3348 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3349 c ees0m(num_conti,i)=0.0D0
3351 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3352 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3353 C Angular derivatives of the contact function
3355 ees0pij1=fac3/ees0pij
3356 ees0mij1=fac3/ees0mij
3357 fac3p=-3.0D0*fac3*rrmij
3358 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3359 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3361 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3362 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3363 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3364 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3365 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3366 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3367 ecosap=ecosa1+ecosa2
3368 ecosbp=ecosb1+ecosb2
3369 ecosgp=ecosg1+ecosg2
3370 ecosam=ecosa1-ecosa2
3371 ecosbm=ecosb1-ecosb2
3372 ecosgm=ecosg1-ecosg2
3381 facont_hb(num_conti,i)=fcont
3384 fprimcont=fprimcont/rij
3385 cd facont_hb(num_conti,i)=1.0D0
3386 C Following line is for diagnostics.
3389 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3390 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3393 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3394 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3396 gggp(1)=gggp(1)+ees0pijp*xj
3397 gggp(2)=gggp(2)+ees0pijp*yj
3398 gggp(3)=gggp(3)+ees0pijp*zj
3399 gggm(1)=gggm(1)+ees0mijp*xj
3400 gggm(2)=gggm(2)+ees0mijp*yj
3401 gggm(3)=gggm(3)+ees0mijp*zj
3402 C Derivatives due to the contact function
3403 gacont_hbr(1,num_conti,i)=fprimcont*xj
3404 gacont_hbr(2,num_conti,i)=fprimcont*yj
3405 gacont_hbr(3,num_conti,i)=fprimcont*zj
3408 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3409 c following the change of gradient-summation algorithm.
3411 cgrad ghalfp=0.5D0*gggp(k)
3412 cgrad ghalfm=0.5D0*gggm(k)
3413 gacontp_hb1(k,num_conti,i)=!ghalfp
3414 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3415 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3416 & *fac_shield(i)*fac_shield(j)
3418 gacontp_hb2(k,num_conti,i)=!ghalfp
3419 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3420 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3421 & *fac_shield(i)*fac_shield(j)
3423 gacontp_hb3(k,num_conti,i)=gggp(k)
3424 & *fac_shield(i)*fac_shield(j)
3426 gacontm_hb1(k,num_conti,i)=!ghalfm
3427 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3428 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3429 & *fac_shield(i)*fac_shield(j)
3431 gacontm_hb2(k,num_conti,i)=!ghalfm
3432 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3433 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3434 & *fac_shield(i)*fac_shield(j)
3436 gacontm_hb3(k,num_conti,i)=gggm(k)
3437 & *fac_shield(i)*fac_shield(j)
3440 C Diagnostics. Comment out or remove after debugging!
3442 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3443 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3444 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3445 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3446 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3447 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3453 endif ! num_conti.le.maxconts
3457 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3460 ghalf=0.5d0*agg(l,k)
3461 aggi(l,k)=aggi(l,k)+ghalf
3462 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3463 aggj(l,k)=aggj(l,k)+ghalf
3466 if (j.eq.nres-1 .and. i.lt.j-2) then
3469 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3475 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3478 C-----------------------------------------------------------------------------
3479 subroutine eturn3(i,eello_turn3)
3480 C Third- and fourth-order contributions from turns
3481 implicit real*8 (a-h,o-z)
3482 include 'DIMENSIONS'
3483 include 'DIMENSIONS.ZSCOPT'
3484 include 'COMMON.IOUNITS'
3485 include 'COMMON.GEO'
3486 include 'COMMON.VAR'
3487 include 'COMMON.LOCAL'
3488 include 'COMMON.CHAIN'
3489 include 'COMMON.DERIV'
3490 include 'COMMON.INTERACT'
3491 include 'COMMON.CONTACTS'
3492 include 'COMMON.TORSION'
3493 include 'COMMON.VECTORS'
3494 include 'COMMON.FFIELD'
3495 include 'COMMON.CONTROL'
3496 include 'COMMON.SHIELD'
3498 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3499 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3500 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3501 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3502 & auxgmat2(2,2),auxgmatt2(2,2)
3503 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3504 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3505 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3506 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3509 c write (iout,*) "eturn3",i,j,j1,j2
3514 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3516 C Third-order contributions
3523 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3524 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3525 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3526 c auxalary matices for theta gradient
3527 c auxalary matrix for i+1 and constant i+2
3528 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3529 c auxalary matrix for i+2 and constant i+1
3530 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3531 call transpose2(auxmat(1,1),auxmat1(1,1))
3532 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3533 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3534 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3535 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3536 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3537 if (shield_mode.eq.0) then
3544 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3545 & *fac_shield(i)*fac_shield(j)
3546 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3547 & *fac_shield(i)*fac_shield(j)
3548 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3552 C Derivatives in theta
3553 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3554 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3555 & *fac_shield(i)*fac_shield(j)
3556 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3557 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3558 & *fac_shield(i)*fac_shield(j)
3561 C Derivatives in shield mode
3562 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3563 & (shield_mode.gt.0)) then
3566 do ilist=1,ishield_list(i)
3567 iresshield=shield_list(ilist,i)
3569 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3571 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3573 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3574 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3578 do ilist=1,ishield_list(j)
3579 iresshield=shield_list(ilist,j)
3581 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3583 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3585 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3586 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3593 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3594 & grad_shield(k,i)*eello_t3/fac_shield(i)
3595 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3596 & grad_shield(k,j)*eello_t3/fac_shield(j)
3597 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3598 & grad_shield(k,i)*eello_t3/fac_shield(i)
3599 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3600 & grad_shield(k,j)*eello_t3/fac_shield(j)
3604 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3605 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3606 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3607 cd & ' eello_turn3_num',4*eello_turn3_num
3608 C Derivatives in gamma(i)
3609 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3610 call transpose2(auxmat2(1,1),auxmat3(1,1))
3611 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3612 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3613 & *fac_shield(i)*fac_shield(j)
3614 C Derivatives in gamma(i+1)
3615 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3616 call transpose2(auxmat2(1,1),auxmat3(1,1))
3617 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3618 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3619 & +0.5d0*(pizda(1,1)+pizda(2,2))
3620 & *fac_shield(i)*fac_shield(j)
3621 C Cartesian derivatives
3623 c ghalf1=0.5d0*agg(l,1)
3624 c ghalf2=0.5d0*agg(l,2)
3625 c ghalf3=0.5d0*agg(l,3)
3626 c ghalf4=0.5d0*agg(l,4)
3627 a_temp(1,1)=aggi(l,1)!+ghalf1
3628 a_temp(1,2)=aggi(l,2)!+ghalf2
3629 a_temp(2,1)=aggi(l,3)!+ghalf3
3630 a_temp(2,2)=aggi(l,4)!+ghalf4
3631 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3632 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3633 & +0.5d0*(pizda(1,1)+pizda(2,2))
3634 & *fac_shield(i)*fac_shield(j)
3636 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3637 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3638 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3639 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3640 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3641 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3642 & +0.5d0*(pizda(1,1)+pizda(2,2))
3643 & *fac_shield(i)*fac_shield(j)
3644 a_temp(1,1)=aggj(l,1)!+ghalf1
3645 a_temp(1,2)=aggj(l,2)!+ghalf2
3646 a_temp(2,1)=aggj(l,3)!+ghalf3
3647 a_temp(2,2)=aggj(l,4)!+ghalf4
3648 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3649 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3650 & +0.5d0*(pizda(1,1)+pizda(2,2))
3651 & *fac_shield(i)*fac_shield(j)
3652 a_temp(1,1)=aggj1(l,1)
3653 a_temp(1,2)=aggj1(l,2)
3654 a_temp(2,1)=aggj1(l,3)
3655 a_temp(2,2)=aggj1(l,4)
3656 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3657 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3658 & +0.5d0*(pizda(1,1)+pizda(2,2))
3659 & *fac_shield(i)*fac_shield(j)
3666 C-------------------------------------------------------------------------------
3667 subroutine eturn4(i,eello_turn4)
3668 C Third- and fourth-order contributions from turns
3669 implicit real*8 (a-h,o-z)
3670 include 'DIMENSIONS'
3671 include 'DIMENSIONS.ZSCOPT'
3672 include 'COMMON.IOUNITS'
3673 include 'COMMON.GEO'
3674 include 'COMMON.VAR'
3675 include 'COMMON.LOCAL'
3676 include 'COMMON.CHAIN'
3677 include 'COMMON.DERIV'
3678 include 'COMMON.INTERACT'
3679 include 'COMMON.CONTACTS'
3680 include 'COMMON.TORSION'
3681 include 'COMMON.VECTORS'
3682 include 'COMMON.FFIELD'
3683 include 'COMMON.CONTROL'
3684 include 'COMMON.SHIELD'
3686 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3687 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3688 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3689 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3690 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3691 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3692 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3693 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3694 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3695 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3696 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3699 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3701 C Fourth-order contributions
3709 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3710 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3711 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3712 c write(iout,*)"WCHODZE W PROGRAM"
3717 iti1=itype2loc(itype(i+1))
3718 iti2=itype2loc(itype(i+2))
3719 iti3=itype2loc(itype(i+3))
3720 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3721 call transpose2(EUg(1,1,i+1),e1t(1,1))
3722 call transpose2(Eug(1,1,i+2),e2t(1,1))
3723 call transpose2(Eug(1,1,i+3),e3t(1,1))
3724 C Ematrix derivative in theta
3725 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3726 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3727 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3728 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3729 c eta1 in derivative theta
3730 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3731 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3732 c auxgvec is derivative of Ub2 so i+3 theta
3733 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3734 c auxalary matrix of E i+1
3735 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3738 s1=scalar2(b1(1,i+2),auxvec(1))
3739 c derivative of theta i+2 with constant i+3
3740 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3741 c derivative of theta i+2 with constant i+2
3742 gs32=scalar2(b1(1,i+2),auxgvec(1))
3743 c derivative of E matix in theta of i+1
3744 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3746 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3747 c ea31 in derivative theta
3748 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3749 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3750 c auxilary matrix auxgvec of Ub2 with constant E matirx
3751 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3752 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3753 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3757 s2=scalar2(b1(1,i+1),auxvec(1))
3758 c derivative of theta i+1 with constant i+3
3759 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3760 c derivative of theta i+2 with constant i+1
3761 gs21=scalar2(b1(1,i+1),auxgvec(1))
3762 c derivative of theta i+3 with constant i+1
3763 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3764 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3766 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3767 c two derivatives over diffetent matrices
3768 c gtae3e2 is derivative over i+3
3769 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3770 c ae3gte2 is derivative over i+2
3771 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3772 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3773 c three possible derivative over theta E matices
3775 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3777 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3779 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3780 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3782 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3783 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3784 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3785 if (shield_mode.eq.0) then
3792 eello_turn4=eello_turn4-(s1+s2+s3)
3793 & *fac_shield(i)*fac_shield(j)
3794 eello_t4=-(s1+s2+s3)
3795 & *fac_shield(i)*fac_shield(j)
3796 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3797 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3798 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3799 C Now derivative over shield:
3800 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3801 & (shield_mode.gt.0)) then
3804 do ilist=1,ishield_list(i)
3805 iresshield=shield_list(ilist,i)
3807 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3809 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3811 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3812 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3816 do ilist=1,ishield_list(j)
3817 iresshield=shield_list(ilist,j)
3819 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3821 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3823 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3824 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3831 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3832 & grad_shield(k,i)*eello_t4/fac_shield(i)
3833 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3834 & grad_shield(k,j)*eello_t4/fac_shield(j)
3835 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3836 & grad_shield(k,i)*eello_t4/fac_shield(i)
3837 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3838 & grad_shield(k,j)*eello_t4/fac_shield(j)
3841 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3842 cd & ' eello_turn4_num',8*eello_turn4_num
3844 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3845 & -(gs13+gsE13+gsEE1)*wturn4
3846 & *fac_shield(i)*fac_shield(j)
3847 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3848 & -(gs23+gs21+gsEE2)*wturn4
3849 & *fac_shield(i)*fac_shield(j)
3851 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3852 & -(gs32+gsE31+gsEE3)*wturn4
3853 & *fac_shield(i)*fac_shield(j)
3855 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3858 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3859 & 'eturn4',i,j,-(s1+s2+s3)
3860 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3861 c & ' eello_turn4_num',8*eello_turn4_num
3862 C Derivatives in gamma(i)
3863 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3864 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3865 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3866 s1=scalar2(b1(1,i+2),auxvec(1))
3867 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3868 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3869 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3870 & *fac_shield(i)*fac_shield(j)
3871 C Derivatives in gamma(i+1)
3872 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3873 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3874 s2=scalar2(b1(1,i+1),auxvec(1))
3875 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3876 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3877 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3878 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3879 & *fac_shield(i)*fac_shield(j)
3880 C Derivatives in gamma(i+2)
3881 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3882 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3883 s1=scalar2(b1(1,i+2),auxvec(1))
3884 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3885 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3886 s2=scalar2(b1(1,i+1),auxvec(1))
3887 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3888 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3889 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3890 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3891 & *fac_shield(i)*fac_shield(j)
3893 C Cartesian derivatives
3894 C Derivatives of this turn contributions in DC(i+2)
3895 if (j.lt.nres-1) then
3897 a_temp(1,1)=agg(l,1)
3898 a_temp(1,2)=agg(l,2)
3899 a_temp(2,1)=agg(l,3)
3900 a_temp(2,2)=agg(l,4)
3901 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3902 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3903 s1=scalar2(b1(1,i+2),auxvec(1))
3904 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3905 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3906 s2=scalar2(b1(1,i+1),auxvec(1))
3907 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3908 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3909 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3911 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3912 & *fac_shield(i)*fac_shield(j)
3915 C Remaining derivatives of this turn contribution
3917 a_temp(1,1)=aggi(l,1)
3918 a_temp(1,2)=aggi(l,2)
3919 a_temp(2,1)=aggi(l,3)
3920 a_temp(2,2)=aggi(l,4)
3921 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3922 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3923 s1=scalar2(b1(1,i+2),auxvec(1))
3924 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3925 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3926 s2=scalar2(b1(1,i+1),auxvec(1))
3927 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3928 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3929 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3930 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3931 & *fac_shield(i)*fac_shield(j)
3932 a_temp(1,1)=aggi1(l,1)
3933 a_temp(1,2)=aggi1(l,2)
3934 a_temp(2,1)=aggi1(l,3)
3935 a_temp(2,2)=aggi1(l,4)
3936 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3937 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3938 s1=scalar2(b1(1,i+2),auxvec(1))
3939 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3940 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3941 s2=scalar2(b1(1,i+1),auxvec(1))
3942 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3943 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3944 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3945 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3946 & *fac_shield(i)*fac_shield(j)
3947 a_temp(1,1)=aggj(l,1)
3948 a_temp(1,2)=aggj(l,2)
3949 a_temp(2,1)=aggj(l,3)
3950 a_temp(2,2)=aggj(l,4)
3951 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3952 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3953 s1=scalar2(b1(1,i+2),auxvec(1))
3954 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3955 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3956 s2=scalar2(b1(1,i+1),auxvec(1))
3957 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3958 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3959 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3960 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3961 & *fac_shield(i)*fac_shield(j)
3962 a_temp(1,1)=aggj1(l,1)
3963 a_temp(1,2)=aggj1(l,2)
3964 a_temp(2,1)=aggj1(l,3)
3965 a_temp(2,2)=aggj1(l,4)
3966 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3967 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3968 s1=scalar2(b1(1,i+2),auxvec(1))
3969 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3970 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3971 s2=scalar2(b1(1,i+1),auxvec(1))
3972 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3973 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3974 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3975 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3976 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3977 & *fac_shield(i)*fac_shield(j)
3984 C-----------------------------------------------------------------------------
3985 subroutine vecpr(u,v,w)
3986 implicit real*8(a-h,o-z)
3987 dimension u(3),v(3),w(3)
3988 w(1)=u(2)*v(3)-u(3)*v(2)
3989 w(2)=-u(1)*v(3)+u(3)*v(1)
3990 w(3)=u(1)*v(2)-u(2)*v(1)
3993 C-----------------------------------------------------------------------------
3994 subroutine unormderiv(u,ugrad,unorm,ungrad)
3995 C This subroutine computes the derivatives of a normalized vector u, given
3996 C the derivatives computed without normalization conditions, ugrad. Returns
3999 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4000 double precision vec(3)
4001 double precision scalar
4003 c write (2,*) 'ugrad',ugrad
4006 vec(i)=scalar(ugrad(1,i),u(1))
4008 c write (2,*) 'vec',vec
4011 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4014 c write (2,*) 'ungrad',ungrad
4017 C-----------------------------------------------------------------------------
4018 subroutine escp(evdw2,evdw2_14)
4020 C This subroutine calculates the excluded-volume interaction energy between
4021 C peptide-group centers and side chains and its gradient in virtual-bond and
4022 C side-chain vectors.
4024 implicit real*8 (a-h,o-z)
4025 include 'DIMENSIONS'
4026 include 'DIMENSIONS.ZSCOPT'
4027 include 'COMMON.CONTROL'
4028 include 'COMMON.GEO'
4029 include 'COMMON.VAR'
4030 include 'COMMON.LOCAL'
4031 include 'COMMON.CHAIN'
4032 include 'COMMON.DERIV'
4033 include 'COMMON.INTERACT'
4034 include 'COMMON.FFIELD'
4035 include 'COMMON.IOUNITS'
4039 cd print '(a)','Enter ESCP'
4040 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4041 c & ' scal14',scal14
4042 do i=iatscp_s,iatscp_e
4043 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4045 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4046 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4047 if (iteli.eq.0) goto 1225
4048 xi=0.5D0*(c(1,i)+c(1,i+1))
4049 yi=0.5D0*(c(2,i)+c(2,i+1))
4050 zi=0.5D0*(c(3,i)+c(3,i+1))
4051 C Returning the ith atom to box
4053 if (xi.lt.0) xi=xi+boxxsize
4055 if (yi.lt.0) yi=yi+boxysize
4057 if (zi.lt.0) zi=zi+boxzsize
4058 do iint=1,nscp_gr(i)
4060 do j=iscpstart(i,iint),iscpend(i,iint)
4061 itypj=iabs(itype(j))
4062 if (itypj.eq.ntyp1) cycle
4063 C Uncomment following three lines for SC-p interactions
4067 C Uncomment following three lines for Ca-p interactions
4071 C returning the jth atom to box
4073 if (xj.lt.0) xj=xj+boxxsize
4075 if (yj.lt.0) yj=yj+boxysize
4077 if (zj.lt.0) zj=zj+boxzsize
4078 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4083 C Finding the closest jth atom
4087 xj=xj_safe+xshift*boxxsize
4088 yj=yj_safe+yshift*boxysize
4089 zj=zj_safe+zshift*boxzsize
4090 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4091 if(dist_temp.lt.dist_init) then
4101 if (subchap.eq.1) then
4110 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4111 C sss is scaling function for smoothing the cutoff gradient otherwise
4112 C the gradient would not be continuouse
4113 sss=sscale(1.0d0/(dsqrt(rrij)))
4114 if (sss.le.0.0d0) cycle
4115 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4117 e1=fac*fac*aad(itypj,iteli)
4118 e2=fac*bad(itypj,iteli)
4119 if (iabs(j-i) .le. 2) then
4122 evdw2_14=evdw2_14+(e1+e2)*sss
4125 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4126 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4127 c & bad(itypj,iteli)
4128 evdw2=evdw2+evdwij*sss
4129 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4130 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4135 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4137 fac=-(evdwij+e1)*rrij*sss
4138 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4143 cd write (iout,*) 'j<i'
4144 C Uncomment following three lines for SC-p interactions
4146 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4149 cd write (iout,*) 'j>i'
4152 C Uncomment following line for SC-p interactions
4153 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4157 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4161 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4162 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4165 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4175 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4176 gradx_scp(j,i)=expon*gradx_scp(j,i)
4179 C******************************************************************************
4183 C To save time the factor EXPON has been extracted from ALL components
4184 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4187 C******************************************************************************
4190 C--------------------------------------------------------------------------
4191 subroutine edis(ehpb)
4193 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4195 implicit real*8 (a-h,o-z)
4196 include 'DIMENSIONS'
4197 include 'DIMENSIONS.ZSCOPT'
4198 include 'COMMON.SBRIDGE'
4199 include 'COMMON.CHAIN'
4200 include 'COMMON.DERIV'
4201 include 'COMMON.VAR'
4202 include 'COMMON.INTERACT'
4203 include 'COMMON.CONTROL'
4204 include 'COMMON.IOUNITS'
4207 c write (iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4208 c write (iout,*)'link_start=',link_start,' link_end=',link_end
4209 C write(iout,*) link_end, "link_end"
4210 if (link_end.eq.0) return
4211 do i=link_start,link_end
4212 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4213 C CA-CA distance used in regularization of structure.
4216 C iii and jjj point to the residues for which the distance is assigned.
4217 if (ii.gt.nres) then
4224 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4225 C distance and angle dependent SS bond potential.
4226 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4227 C & iabs(itype(jjj)).eq.1) then
4228 C write(iout,*) constr_dist,"const"
4229 if (.not.dyn_ss .and. i.le.nss) then
4230 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4231 & iabs(itype(jjj)).eq.1) then
4232 call ssbond_ene(iii,jjj,eij)
4235 else if (ii.gt.nres .and. jj.gt.nres) then
4236 c Restraints from contact prediction
4238 if (constr_dist.eq.11) then
4239 C ehpb=ehpb+fordepth(i)**4.0d0
4240 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4241 ehpb=ehpb+fordepth(i)!**4.0d0
4242 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4243 if (energy_dec) write (iout,'(a6,2i5,6f10.3)') "edisl",ii,jj,
4244 & dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),ehpb
4245 fac=fordepth(i)!**4.0d0
4246 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4247 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4248 C & ehpb,fordepth(i),dd
4249 C write(iout,*) ehpb,"atu?"
4251 C fac=fordepth(i)**4.0d0
4252 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4254 if (dhpb1(i).gt.0.0d0) then
4255 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4256 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4257 c write (iout,*) "beta nmr",
4258 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4262 C Get the force constant corresponding to this distance.
4264 C Calculate the contribution to energy.
4265 ehpb=ehpb+waga*rdis*rdis
4266 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4268 C Evaluate gradient.
4271 endif !end dhpb1(i).gt.0
4272 endif !end const_dist=11
4274 ggg(j)=fac*(c(j,jj)-c(j,ii))
4277 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4278 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4281 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4282 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4285 C write(iout,*) "before"
4287 C write(iout,*) "after",dd
4288 if (constr_dist.eq.11) then
4289 ehpb=ehpb+fordepth(i)!**4.0d0
4290 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4291 if (energy_dec) write (iout,'(a6,2i5,6f10.3)') "edisl",ii,jj,
4292 & dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),ehpb
4293 fac=fordepth(i)!**4.0d0
4294 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4295 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
4296 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
4297 C print *,ehpb,"tu?"
4298 C write(iout,*) ehpb,"btu?",
4299 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
4300 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4301 C & ehpb,fordepth(i),dd
4303 if (dhpb1(i).gt.0.0d0) then
4304 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4305 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4306 c write (iout,*) "alph nmr",
4307 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4310 C Get the force constant corresponding to this distance.
4312 C Calculate the contribution to energy.
4313 ehpb=ehpb+waga*rdis*rdis
4314 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4316 C Evaluate gradient.
4323 ggg(j)=fac*(c(j,jj)-c(j,ii))
4325 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4326 C If this is a SC-SC distance, we need to calculate the contributions to the
4327 C Cartesian gradient in the SC vectors (ghpbx).
4330 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4331 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4336 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4341 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4344 C--------------------------------------------------------------------------
4345 subroutine ssbond_ene(i,j,eij)
4347 C Calculate the distance and angle dependent SS-bond potential energy
4348 C using a free-energy function derived based on RHF/6-31G** ab initio
4349 C calculations of diethyl disulfide.
4351 C A. Liwo and U. Kozlowska, 11/24/03
4353 implicit real*8 (a-h,o-z)
4354 include 'DIMENSIONS'
4355 include 'DIMENSIONS.ZSCOPT'
4356 include 'COMMON.SBRIDGE'
4357 include 'COMMON.CHAIN'
4358 include 'COMMON.DERIV'
4359 include 'COMMON.LOCAL'
4360 include 'COMMON.INTERACT'
4361 include 'COMMON.VAR'
4362 include 'COMMON.IOUNITS'
4363 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4364 itypi=iabs(itype(i))
4368 dxi=dc_norm(1,nres+i)
4369 dyi=dc_norm(2,nres+i)
4370 dzi=dc_norm(3,nres+i)
4371 dsci_inv=dsc_inv(itypi)
4372 itypj=iabs(itype(j))
4373 dscj_inv=dsc_inv(itypj)
4377 dxj=dc_norm(1,nres+j)
4378 dyj=dc_norm(2,nres+j)
4379 dzj=dc_norm(3,nres+j)
4380 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4385 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4386 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4387 om12=dxi*dxj+dyi*dyj+dzi*dzj
4389 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4390 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4396 deltat12=om2-om1+2.0d0
4398 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4399 & +akct*deltad*deltat12
4400 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4401 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4402 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4403 c & " deltat12",deltat12," eij",eij
4404 ed=2*akcm*deltad+akct*deltat12
4406 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4407 eom1=-2*akth*deltat1-pom1-om2*pom2
4408 eom2= 2*akth*deltat2+pom1-om1*pom2
4411 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4414 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4415 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4416 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4417 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4420 C Calculate the components of the gradient in DC and X
4424 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4429 C--------------------------------------------------------------------------
4430 subroutine ebond(estr)
4432 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4434 implicit real*8 (a-h,o-z)
4435 include 'DIMENSIONS'
4436 include 'DIMENSIONS.ZSCOPT'
4437 include 'COMMON.LOCAL'
4438 include 'COMMON.GEO'
4439 include 'COMMON.INTERACT'
4440 include 'COMMON.DERIV'
4441 include 'COMMON.VAR'
4442 include 'COMMON.CHAIN'
4443 include 'COMMON.IOUNITS'
4444 include 'COMMON.NAMES'
4445 include 'COMMON.FFIELD'
4446 include 'COMMON.CONTROL'
4447 double precision u(3),ud(3)
4450 c write (iout,*) "distchainmax",distchainmax
4452 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4453 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4455 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4456 C & *dc(j,i-1)/vbld(i)
4458 C if (energy_dec) write(iout,*)
4459 C & "estr1",i,vbld(i),distchainmax,
4460 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4462 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4463 diff = vbld(i)-vbldpDUM
4464 C write(iout,*) i,diff
4466 diff = vbld(i)-vbldp0
4467 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4471 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4474 C write (iout,'(a7,i5,4f7.3)')
4475 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4477 estr=0.5d0*AKP*estr+estr1
4479 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4483 if (iti.ne.10 .and. iti.ne.ntyp1) then
4486 diff=vbld(i+nres)-vbldsc0(1,iti)
4487 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4488 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4489 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4491 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4495 diff=vbld(i+nres)-vbldsc0(j,iti)
4496 ud(j)=aksc(j,iti)*diff
4497 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4511 uprod2=uprod2*u(k)*u(k)
4515 usumsqder=usumsqder+ud(j)*uprod2
4517 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4518 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4519 estr=estr+uprod/usum
4521 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4529 C--------------------------------------------------------------------------
4530 subroutine ebend(etheta,ethetacnstr)
4532 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4533 C angles gamma and its derivatives in consecutive thetas and gammas.
4535 implicit real*8 (a-h,o-z)
4536 include 'DIMENSIONS'
4537 include 'DIMENSIONS.ZSCOPT'
4538 include 'COMMON.LOCAL'
4539 include 'COMMON.GEO'
4540 include 'COMMON.INTERACT'
4541 include 'COMMON.DERIV'
4542 include 'COMMON.VAR'
4543 include 'COMMON.CHAIN'
4544 include 'COMMON.IOUNITS'
4545 include 'COMMON.NAMES'
4546 include 'COMMON.FFIELD'
4547 include 'COMMON.TORCNSTR'
4548 common /calcthet/ term1,term2,termm,diffak,ratak,
4549 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4550 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4551 double precision y(2),z(2)
4553 c time11=dexp(-2*time)
4556 c write (iout,*) "nres",nres
4557 c write (*,'(a,i2)') 'EBEND ICG=',icg
4558 c write (iout,*) ithet_start,ithet_end
4559 do i=ithet_start,ithet_end
4560 C if (itype(i-1).eq.ntyp1) cycle
4562 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4563 & .or.itype(i).eq.ntyp1) cycle
4564 C Zero the energy function and its derivative at 0 or pi.
4565 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4567 ichir1=isign(1,itype(i-2))
4568 ichir2=isign(1,itype(i))
4569 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4570 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4571 if (itype(i-1).eq.10) then
4572 itype1=isign(10,itype(i-2))
4573 ichir11=isign(1,itype(i-2))
4574 ichir12=isign(1,itype(i-2))
4575 itype2=isign(10,itype(i))
4576 ichir21=isign(1,itype(i))
4577 ichir22=isign(1,itype(i))
4584 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4588 c call proc_proc(phii,icrc)
4589 if (icrc.eq.1) phii=150.0
4600 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4604 c call proc_proc(phii1,icrc)
4605 if (icrc.eq.1) phii1=150.0
4617 C Calculate the "mean" value of theta from the part of the distribution
4618 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4619 C In following comments this theta will be referred to as t_c.
4620 thet_pred_mean=0.0d0
4622 athetk=athet(k,it,ichir1,ichir2)
4623 bthetk=bthet(k,it,ichir1,ichir2)
4625 athetk=athet(k,itype1,ichir11,ichir12)
4626 bthetk=bthet(k,itype2,ichir21,ichir22)
4628 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4630 c write (iout,*) "thet_pred_mean",thet_pred_mean
4631 dthett=thet_pred_mean*ssd
4632 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4633 c write (iout,*) "thet_pred_mean",thet_pred_mean
4634 C Derivatives of the "mean" values in gamma1 and gamma2.
4635 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4636 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4637 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4638 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4640 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4641 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4642 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4643 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4645 if (theta(i).gt.pi-delta) then
4646 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4648 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4649 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4650 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4652 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4654 else if (theta(i).lt.delta) then
4655 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4656 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4657 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4659 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4660 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4663 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4666 etheta=etheta+ethetai
4667 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4668 c & 'ebend',i,ethetai,theta(i),itype(i)
4669 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4670 c & rad2deg*phii,rad2deg*phii1,ethetai
4671 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4672 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4673 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4677 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4678 do i=1,ntheta_constr
4679 itheta=itheta_constr(i)
4680 thetiii=theta(itheta)
4681 difi=pinorm(thetiii-theta_constr0(i))
4682 if (difi.gt.theta_drange(i)) then
4683 difi=difi-theta_drange(i)
4684 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4685 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4686 & +for_thet_constr(i)*difi**3
4687 else if (difi.lt.-drange(i)) then
4689 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4690 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4691 & +for_thet_constr(i)*difi**3
4695 C if (energy_dec) then
4696 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4697 C & i,itheta,rad2deg*thetiii,
4698 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4699 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4700 C & gloc(itheta+nphi-2,icg)
4703 C Ufff.... We've done all this!!!
4706 C---------------------------------------------------------------------------
4707 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4709 implicit real*8 (a-h,o-z)
4710 include 'DIMENSIONS'
4711 include 'COMMON.LOCAL'
4712 include 'COMMON.IOUNITS'
4713 common /calcthet/ term1,term2,termm,diffak,ratak,
4714 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4715 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4716 C Calculate the contributions to both Gaussian lobes.
4717 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4718 C The "polynomial part" of the "standard deviation" of this part of
4722 sig=sig*thet_pred_mean+polthet(j,it)
4724 C Derivative of the "interior part" of the "standard deviation of the"
4725 C gamma-dependent Gaussian lobe in t_c.
4726 sigtc=3*polthet(3,it)
4728 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4731 C Set the parameters of both Gaussian lobes of the distribution.
4732 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4733 fac=sig*sig+sigc0(it)
4736 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4737 sigsqtc=-4.0D0*sigcsq*sigtc
4738 c print *,i,sig,sigtc,sigsqtc
4739 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4740 sigtc=-sigtc/(fac*fac)
4741 C Following variable is sigma(t_c)**(-2)
4742 sigcsq=sigcsq*sigcsq
4744 sig0inv=1.0D0/sig0i**2
4745 delthec=thetai-thet_pred_mean
4746 delthe0=thetai-theta0i
4747 term1=-0.5D0*sigcsq*delthec*delthec
4748 term2=-0.5D0*sig0inv*delthe0*delthe0
4749 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4750 C NaNs in taking the logarithm. We extract the largest exponent which is added
4751 C to the energy (this being the log of the distribution) at the end of energy
4752 C term evaluation for this virtual-bond angle.
4753 if (term1.gt.term2) then
4755 term2=dexp(term2-termm)
4759 term1=dexp(term1-termm)
4762 C The ratio between the gamma-independent and gamma-dependent lobes of
4763 C the distribution is a Gaussian function of thet_pred_mean too.
4764 diffak=gthet(2,it)-thet_pred_mean
4765 ratak=diffak/gthet(3,it)**2
4766 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4767 C Let's differentiate it in thet_pred_mean NOW.
4769 C Now put together the distribution terms to make complete distribution.
4770 termexp=term1+ak*term2
4771 termpre=sigc+ak*sig0i
4772 C Contribution of the bending energy from this theta is just the -log of
4773 C the sum of the contributions from the two lobes and the pre-exponential
4774 C factor. Simple enough, isn't it?
4775 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4776 C NOW the derivatives!!!
4777 C 6/6/97 Take into account the deformation.
4778 E_theta=(delthec*sigcsq*term1
4779 & +ak*delthe0*sig0inv*term2)/termexp
4780 E_tc=((sigtc+aktc*sig0i)/termpre
4781 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4782 & aktc*term2)/termexp)
4785 c-----------------------------------------------------------------------------
4786 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4787 implicit real*8 (a-h,o-z)
4788 include 'DIMENSIONS'
4789 include 'COMMON.LOCAL'
4790 include 'COMMON.IOUNITS'
4791 common /calcthet/ term1,term2,termm,diffak,ratak,
4792 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4793 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4794 delthec=thetai-thet_pred_mean
4795 delthe0=thetai-theta0i
4796 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4797 t3 = thetai-thet_pred_mean
4801 t14 = t12+t6*sigsqtc
4803 t21 = thetai-theta0i
4809 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4810 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4811 & *(-t12*t9-ak*sig0inv*t27)
4815 C--------------------------------------------------------------------------
4816 subroutine ebend(etheta)
4818 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4819 C angles gamma and its derivatives in consecutive thetas and gammas.
4820 C ab initio-derived potentials from
4821 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4823 implicit real*8 (a-h,o-z)
4824 include 'DIMENSIONS'
4825 include 'DIMENSIONS.ZSCOPT'
4826 include 'COMMON.LOCAL'
4827 include 'COMMON.GEO'
4828 include 'COMMON.INTERACT'
4829 include 'COMMON.DERIV'
4830 include 'COMMON.VAR'
4831 include 'COMMON.CHAIN'
4832 include 'COMMON.IOUNITS'
4833 include 'COMMON.NAMES'
4834 include 'COMMON.FFIELD'
4835 include 'COMMON.CONTROL'
4836 include 'COMMON.TORCNSTR'
4837 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4838 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4839 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4840 & sinph1ph2(maxdouble,maxdouble)
4841 logical lprn /.false./, lprn1 /.false./
4843 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4844 do i=ithet_start,ithet_end
4846 C if (itype(i-1).eq.ntyp1) cycle
4848 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4849 & .or.itype(i).eq.ntyp1) cycle
4850 if (iabs(itype(i+1)).eq.20) iblock=2
4851 if (iabs(itype(i+1)).ne.20) iblock=1
4855 theti2=0.5d0*theta(i)
4856 ityp2=ithetyp((itype(i-1)))
4858 coskt(k)=dcos(k*theti2)
4859 sinkt(k)=dsin(k*theti2)
4869 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4872 if (phii.ne.phii) phii=150.0
4876 ityp1=ithetyp((itype(i-2)))
4878 cosph1(k)=dcos(k*phii)
4879 sinph1(k)=dsin(k*phii)
4885 ityp1=ithetyp((itype(i-2)))
4891 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4894 if (phii1.ne.phii1) phii1=150.0
4899 ityp3=ithetyp((itype(i)))
4901 cosph2(k)=dcos(k*phii1)
4902 sinph2(k)=dsin(k*phii1)
4907 ityp3=ithetyp((itype(i)))
4913 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4914 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4916 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4919 ccl=cosph1(l)*cosph2(k-l)
4920 ssl=sinph1(l)*sinph2(k-l)
4921 scl=sinph1(l)*cosph2(k-l)
4922 csl=cosph1(l)*sinph2(k-l)
4923 cosph1ph2(l,k)=ccl-ssl
4924 cosph1ph2(k,l)=ccl+ssl
4925 sinph1ph2(l,k)=scl+csl
4926 sinph1ph2(k,l)=scl-csl
4930 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4931 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4932 write (iout,*) "coskt and sinkt"
4934 write (iout,*) k,coskt(k),sinkt(k)
4938 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4939 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4942 & write (iout,*) "k",k,"
4943 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4944 & " ethetai",ethetai
4947 write (iout,*) "cosph and sinph"
4949 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4951 write (iout,*) "cosph1ph2 and sinph2ph2"
4954 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4955 & sinph1ph2(l,k),sinph1ph2(k,l)
4958 write(iout,*) "ethetai",ethetai
4962 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4963 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4964 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4965 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4966 ethetai=ethetai+sinkt(m)*aux
4967 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4968 dephii=dephii+k*sinkt(m)*(
4969 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4970 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4971 dephii1=dephii1+k*sinkt(m)*(
4972 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4973 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4975 & write (iout,*) "m",m," k",k," bbthet",
4976 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4977 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4978 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4979 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4983 & write(iout,*) "ethetai",ethetai
4987 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4988 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4989 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4990 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4991 ethetai=ethetai+sinkt(m)*aux
4992 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4993 dephii=dephii+l*sinkt(m)*(
4994 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4995 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4996 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4997 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4998 dephii1=dephii1+(k-l)*sinkt(m)*(
4999 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5000 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5001 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5002 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5004 write (iout,*) "m",m," k",k," l",l," ffthet",
5005 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5006 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5007 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5008 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5009 & " ethetai",ethetai
5010 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5011 & cosph1ph2(k,l)*sinkt(m),
5012 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5018 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5019 & i,theta(i)*rad2deg,phii*rad2deg,
5020 & phii1*rad2deg,ethetai
5021 etheta=etheta+ethetai
5022 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5023 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5024 c gloc(nphi+i-2,icg)=wang*dethetai
5025 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5031 c-----------------------------------------------------------------------------
5032 subroutine esc(escloc)
5033 C Calculate the local energy of a side chain and its derivatives in the
5034 C corresponding virtual-bond valence angles THETA and the spherical angles
5036 implicit real*8 (a-h,o-z)
5037 include 'DIMENSIONS'
5038 include 'DIMENSIONS.ZSCOPT'
5039 include 'COMMON.GEO'
5040 include 'COMMON.LOCAL'
5041 include 'COMMON.VAR'
5042 include 'COMMON.INTERACT'
5043 include 'COMMON.DERIV'
5044 include 'COMMON.CHAIN'
5045 include 'COMMON.IOUNITS'
5046 include 'COMMON.NAMES'
5047 include 'COMMON.FFIELD'
5048 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5049 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5050 common /sccalc/ time11,time12,time112,theti,it,nlobit
5053 C write (iout,*) 'ESC'
5054 do i=loc_start,loc_end
5056 if (it.eq.ntyp1) cycle
5057 if (it.eq.10) goto 1
5058 nlobit=nlob(iabs(it))
5059 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5060 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5061 theti=theta(i+1)-pipol
5065 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5067 if (x(2).gt.pi-delta) then
5071 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5073 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5074 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5076 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5077 & ddersc0(1),dersc(1))
5078 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5079 & ddersc0(3),dersc(3))
5081 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5083 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5084 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5085 & dersc0(2),esclocbi,dersc02)
5086 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5088 call splinthet(x(2),0.5d0*delta,ss,ssd)
5093 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5095 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5096 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5098 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5100 c write (iout,*) escloci
5101 else if (x(2).lt.delta) then
5105 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5107 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5108 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5110 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5111 & ddersc0(1),dersc(1))
5112 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5113 & ddersc0(3),dersc(3))
5115 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5117 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5118 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5119 & dersc0(2),esclocbi,dersc02)
5120 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5125 call splinthet(x(2),0.5d0*delta,ss,ssd)
5127 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5129 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5130 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5132 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5133 C write (iout,*) 'i=',i, escloci
5135 call enesc(x,escloci,dersc,ddummy,.false.)
5138 escloc=escloc+escloci
5139 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5140 write (iout,'(a6,i5,0pf7.3)')
5141 & 'escloc',i,escloci
5143 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5145 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5146 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5151 C---------------------------------------------------------------------------
5152 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5153 implicit real*8 (a-h,o-z)
5154 include 'DIMENSIONS'
5155 include 'COMMON.GEO'
5156 include 'COMMON.LOCAL'
5157 include 'COMMON.IOUNITS'
5158 common /sccalc/ time11,time12,time112,theti,it,nlobit
5159 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5160 double precision contr(maxlob,-1:1)
5162 c write (iout,*) 'it=',it,' nlobit=',nlobit
5166 if (mixed) ddersc(j)=0.0d0
5170 C Because of periodicity of the dependence of the SC energy in omega we have
5171 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5172 C To avoid underflows, first compute & store the exponents.
5180 z(k)=x(k)-censc(k,j,it)
5185 Axk=Axk+gaussc(l,k,j,it)*z(l)
5191 expfac=expfac+Ax(k,j,iii)*z(k)
5199 C As in the case of ebend, we want to avoid underflows in exponentiation and
5200 C subsequent NaNs and INFs in energy calculation.
5201 C Find the largest exponent
5205 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5209 cd print *,'it=',it,' emin=',emin
5211 C Compute the contribution to SC energy and derivatives
5215 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5216 cd print *,'j=',j,' expfac=',expfac
5217 escloc_i=escloc_i+expfac
5219 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5223 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5224 & +gaussc(k,2,j,it))*expfac
5231 dersc(1)=dersc(1)/cos(theti)**2
5232 ddersc(1)=ddersc(1)/cos(theti)**2
5235 escloci=-(dlog(escloc_i)-emin)
5237 dersc(j)=dersc(j)/escloc_i
5241 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5246 C------------------------------------------------------------------------------
5247 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5248 implicit real*8 (a-h,o-z)
5249 include 'DIMENSIONS'
5250 include 'COMMON.GEO'
5251 include 'COMMON.LOCAL'
5252 include 'COMMON.IOUNITS'
5253 common /sccalc/ time11,time12,time112,theti,it,nlobit
5254 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5255 double precision contr(maxlob)
5266 z(k)=x(k)-censc(k,j,it)
5272 Axk=Axk+gaussc(l,k,j,it)*z(l)
5278 expfac=expfac+Ax(k,j)*z(k)
5283 C As in the case of ebend, we want to avoid underflows in exponentiation and
5284 C subsequent NaNs and INFs in energy calculation.
5285 C Find the largest exponent
5288 if (emin.gt.contr(j)) emin=contr(j)
5292 C Compute the contribution to SC energy and derivatives
5296 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5297 escloc_i=escloc_i+expfac
5299 dersc(k)=dersc(k)+Ax(k,j)*expfac
5301 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5302 & +gaussc(1,2,j,it))*expfac
5306 dersc(1)=dersc(1)/cos(theti)**2
5307 dersc12=dersc12/cos(theti)**2
5308 escloci=-(dlog(escloc_i)-emin)
5310 dersc(j)=dersc(j)/escloc_i
5312 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5316 c----------------------------------------------------------------------------------
5317 subroutine esc(escloc)
5318 C Calculate the local energy of a side chain and its derivatives in the
5319 C corresponding virtual-bond valence angles THETA and the spherical angles
5320 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5321 C added by Urszula Kozlowska. 07/11/2007
5323 implicit real*8 (a-h,o-z)
5324 include 'DIMENSIONS'
5325 include 'DIMENSIONS.ZSCOPT'
5326 include 'COMMON.GEO'
5327 include 'COMMON.LOCAL'
5328 include 'COMMON.VAR'
5329 include 'COMMON.SCROT'
5330 include 'COMMON.INTERACT'
5331 include 'COMMON.DERIV'
5332 include 'COMMON.CHAIN'
5333 include 'COMMON.IOUNITS'
5334 include 'COMMON.NAMES'
5335 include 'COMMON.FFIELD'
5336 include 'COMMON.CONTROL'
5337 include 'COMMON.VECTORS'
5338 double precision x_prime(3),y_prime(3),z_prime(3)
5339 & , sumene,dsc_i,dp2_i,x(65),
5340 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5341 & de_dxx,de_dyy,de_dzz,de_dt
5342 double precision s1_t,s1_6_t,s2_t,s2_6_t
5344 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5345 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5346 & dt_dCi(3),dt_dCi1(3)
5347 common /sccalc/ time11,time12,time112,theti,it,nlobit
5350 do i=loc_start,loc_end
5351 if (itype(i).eq.ntyp1) cycle
5352 costtab(i+1) =dcos(theta(i+1))
5353 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5354 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5355 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5356 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5357 cosfac=dsqrt(cosfac2)
5358 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5359 sinfac=dsqrt(sinfac2)
5361 if (it.eq.10) goto 1
5363 C Compute the axes of tghe local cartesian coordinates system; store in
5364 c x_prime, y_prime and z_prime
5371 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5372 C & dc_norm(3,i+nres)
5374 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5375 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5378 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5381 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5382 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5383 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5384 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5385 c & " xy",scalar(x_prime(1),y_prime(1)),
5386 c & " xz",scalar(x_prime(1),z_prime(1)),
5387 c & " yy",scalar(y_prime(1),y_prime(1)),
5388 c & " yz",scalar(y_prime(1),z_prime(1)),
5389 c & " zz",scalar(z_prime(1),z_prime(1))
5391 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5392 C to local coordinate system. Store in xx, yy, zz.
5398 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5399 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5400 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5407 C Compute the energy of the ith side cbain
5409 c write (2,*) "xx",xx," yy",yy," zz",zz
5412 x(j) = sc_parmin(j,it)
5415 Cc diagnostics - remove later
5417 yy1 = dsin(alph(2))*dcos(omeg(2))
5418 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5419 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5420 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5422 C," --- ", xx_w,yy_w,zz_w
5425 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5426 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5428 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5429 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5431 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5432 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5433 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5434 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5435 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5437 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5438 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5439 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5440 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5441 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5443 dsc_i = 0.743d0+x(61)
5445 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5446 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5447 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5448 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5449 s1=(1+x(63))/(0.1d0 + dscp1)
5450 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5451 s2=(1+x(65))/(0.1d0 + dscp2)
5452 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5453 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5454 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5455 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5457 c & dscp1,dscp2,sumene
5458 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5459 escloc = escloc + sumene
5460 c write (2,*) "escloc",escloc
5461 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5463 if (.not. calc_grad) goto 1
5466 C This section to check the numerical derivatives of the energy of ith side
5467 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5468 C #define DEBUG in the code to turn it on.
5470 write (2,*) "sumene =",sumene
5474 write (2,*) xx,yy,zz
5475 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5476 de_dxx_num=(sumenep-sumene)/aincr
5478 write (2,*) "xx+ sumene from enesc=",sumenep
5481 write (2,*) xx,yy,zz
5482 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5483 de_dyy_num=(sumenep-sumene)/aincr
5485 write (2,*) "yy+ sumene from enesc=",sumenep
5488 write (2,*) xx,yy,zz
5489 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5490 de_dzz_num=(sumenep-sumene)/aincr
5492 write (2,*) "zz+ sumene from enesc=",sumenep
5493 costsave=cost2tab(i+1)
5494 sintsave=sint2tab(i+1)
5495 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5496 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5497 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5498 de_dt_num=(sumenep-sumene)/aincr
5499 write (2,*) " t+ sumene from enesc=",sumenep
5500 cost2tab(i+1)=costsave
5501 sint2tab(i+1)=sintsave
5502 C End of diagnostics section.
5505 C Compute the gradient of esc
5507 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5508 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5509 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5510 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5511 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5512 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5513 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5514 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5515 pom1=(sumene3*sint2tab(i+1)+sumene1)
5516 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5517 pom2=(sumene4*cost2tab(i+1)+sumene2)
5518 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5519 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5520 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5521 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5523 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5524 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5525 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5527 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5528 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5529 & +(pom1+pom2)*pom_dx
5531 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5534 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5535 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5536 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5538 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5539 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5540 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5541 & +x(59)*zz**2 +x(60)*xx*zz
5542 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5543 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5544 & +(pom1-pom2)*pom_dy
5546 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5549 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5550 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5551 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5552 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5553 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5554 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5555 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5556 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5558 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5561 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5562 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5563 & +pom1*pom_dt1+pom2*pom_dt2
5565 write(2,*), "de_dt = ", de_dt,de_dt_num
5569 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5570 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5571 cosfac2xx=cosfac2*xx
5572 sinfac2yy=sinfac2*yy
5574 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5576 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5578 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5579 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5580 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5581 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5582 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5583 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5584 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5585 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5586 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5587 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5591 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5592 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5593 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5594 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5597 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5598 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5599 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5601 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5602 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5606 dXX_Ctab(k,i)=dXX_Ci(k)
5607 dXX_C1tab(k,i)=dXX_Ci1(k)
5608 dYY_Ctab(k,i)=dYY_Ci(k)
5609 dYY_C1tab(k,i)=dYY_Ci1(k)
5610 dZZ_Ctab(k,i)=dZZ_Ci(k)
5611 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5612 dXX_XYZtab(k,i)=dXX_XYZ(k)
5613 dYY_XYZtab(k,i)=dYY_XYZ(k)
5614 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5618 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5619 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5620 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5621 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5622 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5624 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5625 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5626 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5627 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5628 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5629 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5630 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5631 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5633 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5634 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5636 C to check gradient call subroutine check_grad
5643 c------------------------------------------------------------------------------
5644 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5646 C This procedure calculates two-body contact function g(rij) and its derivative:
5649 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5652 C where x=(rij-r0ij)/delta
5654 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5657 double precision rij,r0ij,eps0ij,fcont,fprimcont
5658 double precision x,x2,x4,delta
5662 if (x.lt.-1.0D0) then
5665 else if (x.le.1.0D0) then
5668 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5669 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5676 c------------------------------------------------------------------------------
5677 subroutine splinthet(theti,delta,ss,ssder)
5678 implicit real*8 (a-h,o-z)
5679 include 'DIMENSIONS'
5680 include 'DIMENSIONS.ZSCOPT'
5681 include 'COMMON.VAR'
5682 include 'COMMON.GEO'
5685 if (theti.gt.pipol) then
5686 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5688 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5693 c------------------------------------------------------------------------------
5694 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5696 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5697 double precision ksi,ksi2,ksi3,a1,a2,a3
5698 a1=fprim0*delta/(f1-f0)
5704 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5705 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5708 c------------------------------------------------------------------------------
5709 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5711 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5712 double precision ksi,ksi2,ksi3,a1,a2,a3
5717 a2=3*(f1x-f0x)-2*fprim0x*delta
5718 a3=fprim0x*delta-2*(f1x-f0x)
5719 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5722 C-----------------------------------------------------------------------------
5724 C-----------------------------------------------------------------------------
5725 subroutine etor(etors,fact)
5726 implicit real*8 (a-h,o-z)
5727 include 'DIMENSIONS'
5728 include 'DIMENSIONS.ZSCOPT'
5729 include 'COMMON.VAR'
5730 include 'COMMON.GEO'
5731 include 'COMMON.LOCAL'
5732 include 'COMMON.TORSION'
5733 include 'COMMON.INTERACT'
5734 include 'COMMON.DERIV'
5735 include 'COMMON.CHAIN'
5736 include 'COMMON.NAMES'
5737 include 'COMMON.IOUNITS'
5738 include 'COMMON.FFIELD'
5739 include 'COMMON.TORCNSTR'
5741 C Set lprn=.true. for debugging
5745 do i=iphi_start,iphi_end
5746 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5747 & .or. itype(i).eq.ntyp1) cycle
5748 itori=itortyp(itype(i-2))
5749 itori1=itortyp(itype(i-1))
5752 C Proline-Proline pair is a special case...
5753 if (itori.eq.3 .and. itori1.eq.3) then
5754 if (phii.gt.-dwapi3) then
5756 fac=1.0D0/(1.0D0-cosphi)
5757 etorsi=v1(1,3,3)*fac
5758 etorsi=etorsi+etorsi
5759 etors=etors+etorsi-v1(1,3,3)
5760 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5763 v1ij=v1(j+1,itori,itori1)
5764 v2ij=v2(j+1,itori,itori1)
5767 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5768 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5772 v1ij=v1(j,itori,itori1)
5773 v2ij=v2(j,itori,itori1)
5776 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5777 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5781 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5782 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5783 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5784 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5785 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5789 c------------------------------------------------------------------------------
5791 subroutine etor(etors,fact)
5792 implicit real*8 (a-h,o-z)
5793 include 'DIMENSIONS'
5794 include 'DIMENSIONS.ZSCOPT'
5795 include 'COMMON.VAR'
5796 include 'COMMON.GEO'
5797 include 'COMMON.LOCAL'
5798 include 'COMMON.TORSION'
5799 include 'COMMON.INTERACT'
5800 include 'COMMON.DERIV'
5801 include 'COMMON.CHAIN'
5802 include 'COMMON.NAMES'
5803 include 'COMMON.IOUNITS'
5804 include 'COMMON.FFIELD'
5805 include 'COMMON.TORCNSTR'
5807 C Set lprn=.true. for debugging
5811 do i=iphi_start,iphi_end
5813 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5814 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5815 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5816 C & .or. itype(i).eq.ntyp1) cycle
5817 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5818 if (iabs(itype(i)).eq.20) then
5823 itori=itortyp(itype(i-2))
5824 itori1=itortyp(itype(i-1))
5827 C Regular cosine and sine terms
5828 do j=1,nterm(itori,itori1,iblock)
5829 v1ij=v1(j,itori,itori1,iblock)
5830 v2ij=v2(j,itori,itori1,iblock)
5833 etors=etors+v1ij*cosphi+v2ij*sinphi
5834 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5838 C E = SUM ----------------------------------- - v1
5839 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5841 cosphi=dcos(0.5d0*phii)
5842 sinphi=dsin(0.5d0*phii)
5843 do j=1,nlor(itori,itori1,iblock)
5844 vl1ij=vlor1(j,itori,itori1)
5845 vl2ij=vlor2(j,itori,itori1)
5846 vl3ij=vlor3(j,itori,itori1)
5847 pom=vl2ij*cosphi+vl3ij*sinphi
5848 pom1=1.0d0/(pom*pom+1.0d0)
5849 etors=etors+vl1ij*pom1
5850 c if (energy_dec) etors_ii=etors_ii+
5853 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5855 C Subtract the constant term
5856 etors=etors-v0(itori,itori1,iblock)
5858 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5859 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5860 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5861 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5862 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5867 c----------------------------------------------------------------------------
5868 subroutine etor_d(etors_d,fact2)
5869 C 6/23/01 Compute double torsional energy
5870 implicit real*8 (a-h,o-z)
5871 include 'DIMENSIONS'
5872 include 'DIMENSIONS.ZSCOPT'
5873 include 'COMMON.VAR'
5874 include 'COMMON.GEO'
5875 include 'COMMON.LOCAL'
5876 include 'COMMON.TORSION'
5877 include 'COMMON.INTERACT'
5878 include 'COMMON.DERIV'
5879 include 'COMMON.CHAIN'
5880 include 'COMMON.NAMES'
5881 include 'COMMON.IOUNITS'
5882 include 'COMMON.FFIELD'
5883 include 'COMMON.TORCNSTR'
5885 C Set lprn=.true. for debugging
5889 do i=iphi_start,iphi_end-1
5891 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5892 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5893 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5894 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5895 & (itype(i+1).eq.ntyp1)) cycle
5896 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5898 itori=itortyp(itype(i-2))
5899 itori1=itortyp(itype(i-1))
5900 itori2=itortyp(itype(i))
5906 if (iabs(itype(i+1)).eq.20) iblock=2
5907 C Regular cosine and sine terms
5908 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5909 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5910 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5911 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5912 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5913 cosphi1=dcos(j*phii)
5914 sinphi1=dsin(j*phii)
5915 cosphi2=dcos(j*phii1)
5916 sinphi2=dsin(j*phii1)
5917 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5918 & v2cij*cosphi2+v2sij*sinphi2
5919 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5920 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5922 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5924 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5925 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5926 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5927 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5928 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5929 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5930 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5931 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5932 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5933 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5934 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5935 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5936 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5937 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5940 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5941 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5947 c---------------------------------------------------------------------------
5948 C The rigorous attempt to derive energy function
5949 subroutine etor_kcc(etors,fact)
5950 implicit real*8 (a-h,o-z)
5951 include 'DIMENSIONS'
5952 include 'DIMENSIONS.ZSCOPT'
5953 include 'COMMON.VAR'
5954 include 'COMMON.GEO'
5955 include 'COMMON.LOCAL'
5956 include 'COMMON.TORSION'
5957 include 'COMMON.INTERACT'
5958 include 'COMMON.DERIV'
5959 include 'COMMON.CHAIN'
5960 include 'COMMON.NAMES'
5961 include 'COMMON.IOUNITS'
5962 include 'COMMON.FFIELD'
5963 include 'COMMON.TORCNSTR'
5964 include 'COMMON.CONTROL'
5965 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
5967 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
5968 C Set lprn=.true. for debugging
5971 C print *,"wchodze kcc"
5972 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
5974 do i=iphi_start,iphi_end
5975 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5976 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5977 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5978 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5979 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5980 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5981 itori=itortyp(itype(i-2))
5982 itori1=itortyp(itype(i-1))
5987 C to avoid multiple devision by 2
5988 c theti22=0.5d0*theta(i)
5989 C theta 12 is the theta_1 /2
5990 C theta 22 is theta_2 /2
5991 c theti12=0.5d0*theta(i-1)
5992 C and appropriate sinus function
5993 sinthet1=dsin(theta(i-1))
5994 sinthet2=dsin(theta(i))
5995 costhet1=dcos(theta(i-1))
5996 costhet2=dcos(theta(i))
5997 C to speed up lets store its mutliplication
5998 sint1t2=sinthet2*sinthet1
6000 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
6001 C +d_n*sin(n*gamma)) *
6002 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
6003 C we have two sum 1) Non-Chebyshev which is with n and gamma
6004 nval=nterm_kcc_Tb(itori,itori1)
6010 c1(j)=c1(j-1)*costhet1
6011 c2(j)=c2(j-1)*costhet2
6014 do j=1,nterm_kcc(itori,itori1)
6018 sint1t2n=sint1t2n*sint1t2
6024 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6025 gradvalct1=gradvalct1+
6026 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6027 gradvalct2=gradvalct2+
6028 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6031 gradvalct1=-gradvalct1*sinthet1
6032 gradvalct2=-gradvalct2*sinthet2
6038 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6039 gradvalst1=gradvalst1+
6040 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6041 gradvalst2=gradvalst2+
6042 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6045 gradvalst1=-gradvalst1*sinthet1
6046 gradvalst2=-gradvalst2*sinthet2
6047 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6048 C glocig is the gradient local i site in gamma
6049 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6050 C now gradient over theta_1
6051 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6052 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6053 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6054 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6057 C derivative over gamma
6058 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6059 C derivative over theta1
6060 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6061 C now derivative over theta2
6062 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6064 write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6065 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6066 write (iout,*) "c1",(c1(k),k=0,nval),
6067 & " c2",(c2(k),k=0,nval)
6068 write (iout,*) "sumvalc",sumvalc," sumvals",sumvals
6073 c---------------------------------------------------------------------------------------------
6074 subroutine etor_constr(edihcnstr)
6075 implicit real*8 (a-h,o-z)
6076 include 'DIMENSIONS'
6077 include 'DIMENSIONS.ZSCOPT'
6078 include 'COMMON.VAR'
6079 include 'COMMON.GEO'
6080 include 'COMMON.LOCAL'
6081 include 'COMMON.TORSION'
6082 include 'COMMON.INTERACT'
6083 include 'COMMON.DERIV'
6084 include 'COMMON.CHAIN'
6085 include 'COMMON.NAMES'
6086 include 'COMMON.IOUNITS'
6087 include 'COMMON.FFIELD'
6088 include 'COMMON.TORCNSTR'
6089 include 'COMMON.CONTROL'
6090 ! 6/20/98 - dihedral angle constraints
6092 c do i=1,ndih_constr
6093 c write (iout,*) "idihconstr_start",idihconstr_start,
6094 c & " idihconstr_end",idihconstr_end
6096 if (raw_psipred) then
6097 do i=idihconstr_start,idihconstr_end
6098 itori=idih_constr(i)
6100 gaudih_i=vpsipred(1,i)
6104 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6105 dexpcos_i=dexp(-cos_i*cos_i)
6106 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6107 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6108 & *cos_i*dexpcos_i/s**2
6110 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6111 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6113 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6114 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6115 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6116 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6117 & -wdihc*dlog(gaudih_i)
6121 do i=idihconstr_start,idihconstr_end
6122 itori=idih_constr(i)
6124 difi=pinorm(phii-phi0(i))
6125 if (difi.gt.drange(i)) then
6127 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6128 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6129 else if (difi.lt.-drange(i)) then
6131 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6132 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6140 c write (iout,*) "ETOR_CONSTR",edihcnstr
6143 c----------------------------------------------------------------------------
6144 C The rigorous attempt to derive energy function
6145 subroutine ebend_kcc(etheta)
6147 implicit real*8 (a-h,o-z)
6148 include 'DIMENSIONS'
6149 include 'DIMENSIONS.ZSCOPT'
6150 include 'COMMON.VAR'
6151 include 'COMMON.GEO'
6152 include 'COMMON.LOCAL'
6153 include 'COMMON.TORSION'
6154 include 'COMMON.INTERACT'
6155 include 'COMMON.DERIV'
6156 include 'COMMON.CHAIN'
6157 include 'COMMON.NAMES'
6158 include 'COMMON.IOUNITS'
6159 include 'COMMON.FFIELD'
6160 include 'COMMON.TORCNSTR'
6161 include 'COMMON.CONTROL'
6163 double precision thybt1(maxang_kcc)
6164 C Set lprn=.true. for debugging
6167 C print *,"wchodze kcc"
6168 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6170 do i=ithet_start,ithet_end
6171 c print *,i,itype(i-1),itype(i),itype(i-2)
6172 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6173 & .or.itype(i).eq.ntyp1) cycle
6174 iti=iabs(itortyp(itype(i-1)))
6175 sinthet=dsin(theta(i))
6176 costhet=dcos(theta(i))
6177 do j=1,nbend_kcc_Tb(iti)
6178 thybt1(j)=v1bend_chyb(j,iti)
6180 sumth1thyb=v1bend_chyb(0,iti)+
6181 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6182 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6184 ihelp=nbend_kcc_Tb(iti)-1
6185 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6186 etheta=etheta+sumth1thyb
6187 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6188 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6192 c-------------------------------------------------------------------------------------
6193 subroutine etheta_constr(ethetacnstr)
6195 implicit real*8 (a-h,o-z)
6196 include 'DIMENSIONS'
6197 include 'DIMENSIONS.ZSCOPT'
6198 include 'COMMON.VAR'
6199 include 'COMMON.GEO'
6200 include 'COMMON.LOCAL'
6201 include 'COMMON.TORSION'
6202 include 'COMMON.INTERACT'
6203 include 'COMMON.DERIV'
6204 include 'COMMON.CHAIN'
6205 include 'COMMON.NAMES'
6206 include 'COMMON.IOUNITS'
6207 include 'COMMON.FFIELD'
6208 include 'COMMON.TORCNSTR'
6209 include 'COMMON.CONTROL'
6211 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6212 do i=ithetaconstr_start,ithetaconstr_end
6213 itheta=itheta_constr(i)
6214 thetiii=theta(itheta)
6215 difi=pinorm(thetiii-theta_constr0(i))
6216 if (difi.gt.theta_drange(i)) then
6217 difi=difi-theta_drange(i)
6218 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6219 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6220 & +for_thet_constr(i)*difi**3
6221 else if (difi.lt.-drange(i)) then
6223 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6224 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6225 & +for_thet_constr(i)*difi**3
6229 if (energy_dec) then
6230 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6231 & i,itheta,rad2deg*thetiii,
6232 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6233 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6234 & gloc(itheta+nphi-2,icg)
6239 c------------------------------------------------------------------------------
6240 c------------------------------------------------------------------------------
6241 subroutine eback_sc_corr(esccor)
6242 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6243 c conformational states; temporarily implemented as differences
6244 c between UNRES torsional potentials (dependent on three types of
6245 c residues) and the torsional potentials dependent on all 20 types
6246 c of residues computed from AM1 energy surfaces of terminally-blocked
6247 c amino-acid residues.
6248 implicit real*8 (a-h,o-z)
6249 include 'DIMENSIONS'
6250 include 'DIMENSIONS.ZSCOPT'
6251 include 'COMMON.VAR'
6252 include 'COMMON.GEO'
6253 include 'COMMON.LOCAL'
6254 include 'COMMON.TORSION'
6255 include 'COMMON.SCCOR'
6256 include 'COMMON.INTERACT'
6257 include 'COMMON.DERIV'
6258 include 'COMMON.CHAIN'
6259 include 'COMMON.NAMES'
6260 include 'COMMON.IOUNITS'
6261 include 'COMMON.FFIELD'
6262 include 'COMMON.CONTROL'
6264 C Set lprn=.true. for debugging
6267 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6269 do i=itau_start,itau_end
6270 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6272 isccori=isccortyp(itype(i-2))
6273 isccori1=isccortyp(itype(i-1))
6275 do intertyp=1,3 !intertyp
6276 cc Added 09 May 2012 (Adasko)
6277 cc Intertyp means interaction type of backbone mainchain correlation:
6278 c 1 = SC...Ca...Ca...Ca
6279 c 2 = Ca...Ca...Ca...SC
6280 c 3 = SC...Ca...Ca...SCi
6282 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6283 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6284 & (itype(i-1).eq.ntyp1)))
6285 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6286 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6287 & .or.(itype(i).eq.ntyp1)))
6288 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6289 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6290 & (itype(i-3).eq.ntyp1)))) cycle
6291 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6292 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6294 do j=1,nterm_sccor(isccori,isccori1)
6295 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6296 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6297 cosphi=dcos(j*tauangle(intertyp,i))
6298 sinphi=dsin(j*tauangle(intertyp,i))
6299 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6300 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6302 C write (iout,*)"EBACK_SC_COR",esccor,i
6303 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6304 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6305 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6307 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6308 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6309 & (v1sccor(j,1,itori,itori1),j=1,6)
6310 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6311 c gsccor_loc(i-3)=gloci
6316 c------------------------------------------------------------------------------
6317 subroutine multibody(ecorr)
6318 C This subroutine calculates multi-body contributions to energy following
6319 C the idea of Skolnick et al. If side chains I and J make a contact and
6320 C at the same time side chains I+1 and J+1 make a contact, an extra
6321 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6322 implicit real*8 (a-h,o-z)
6323 include 'DIMENSIONS'
6324 include 'COMMON.IOUNITS'
6325 include 'COMMON.DERIV'
6326 include 'COMMON.INTERACT'
6327 include 'COMMON.CONTACTS'
6328 double precision gx(3),gx1(3)
6331 C Set lprn=.true. for debugging
6335 write (iout,'(a)') 'Contact function values:'
6337 write (iout,'(i2,20(1x,i2,f10.5))')
6338 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6353 num_conti=num_cont(i)
6354 num_conti1=num_cont(i1)
6359 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6360 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6361 cd & ' ishift=',ishift
6362 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6363 C The system gains extra energy.
6364 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6365 endif ! j1==j+-ishift
6374 c------------------------------------------------------------------------------
6375 double precision function esccorr(i,j,k,l,jj,kk)
6376 implicit real*8 (a-h,o-z)
6377 include 'DIMENSIONS'
6378 include 'COMMON.IOUNITS'
6379 include 'COMMON.DERIV'
6380 include 'COMMON.INTERACT'
6381 include 'COMMON.CONTACTS'
6382 double precision gx(3),gx1(3)
6387 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6388 C Calculate the multi-body contribution to energy.
6389 C Calculate multi-body contributions to the gradient.
6390 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6391 cd & k,l,(gacont(m,kk,k),m=1,3)
6393 gx(m) =ekl*gacont(m,jj,i)
6394 gx1(m)=eij*gacont(m,kk,k)
6395 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6396 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6397 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6398 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6402 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6407 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6413 c------------------------------------------------------------------------------
6414 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6415 C This subroutine calculates multi-body contributions to hydrogen-bonding
6416 implicit real*8 (a-h,o-z)
6417 include 'DIMENSIONS'
6418 include 'DIMENSIONS.ZSCOPT'
6419 include 'COMMON.IOUNITS'
6420 include 'COMMON.FFIELD'
6421 include 'COMMON.DERIV'
6422 include 'COMMON.INTERACT'
6423 include 'COMMON.CONTACTS'
6424 double precision gx(3),gx1(3)
6427 C Set lprn=.true. for debugging
6430 write (iout,'(a)') 'Contact function values:'
6432 write (iout,'(2i3,50(1x,i2,f5.2))')
6433 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6434 & j=1,num_cont_hb(i))
6438 C Remove the loop below after debugging !!!
6445 C Calculate the local-electrostatic correlation terms
6446 do i=iatel_s,iatel_e+1
6448 num_conti=num_cont_hb(i)
6449 num_conti1=num_cont_hb(i+1)
6454 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6455 c & ' jj=',jj,' kk=',kk
6456 if (j1.eq.j+1 .or. j1.eq.j-1) then
6457 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6458 C The system gains extra energy.
6459 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6461 else if (j1.eq.j) then
6462 C Contacts I-J and I-(J+1) occur simultaneously.
6463 C The system loses extra energy.
6464 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6469 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6470 c & ' jj=',jj,' kk=',kk
6472 C Contacts I-J and (I+1)-J occur simultaneously.
6473 C The system loses extra energy.
6474 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6481 c------------------------------------------------------------------------------
6482 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6484 C This subroutine calculates multi-body contributions to hydrogen-bonding
6485 implicit real*8 (a-h,o-z)
6486 include 'DIMENSIONS'
6487 include 'DIMENSIONS.ZSCOPT'
6488 include 'COMMON.IOUNITS'
6492 include 'COMMON.FFIELD'
6493 include 'COMMON.DERIV'
6494 include 'COMMON.LOCAL'
6495 include 'COMMON.INTERACT'
6496 include 'COMMON.CONTACTS'
6497 include 'COMMON.CHAIN'
6498 include 'COMMON.CONTROL'
6499 include 'COMMON.SHIELD'
6500 double precision gx(3),gx1(3)
6501 integer num_cont_hb_old(maxres)
6503 double precision eello4,eello5,eelo6,eello_turn6
6504 external eello4,eello5,eello6,eello_turn6
6505 C Set lprn=.true. for debugging
6509 write (iout,'(a)') 'Contact function values:'
6511 write (iout,'(2i3,50(1x,i2,5f6.3))')
6512 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6513 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6519 C Remove the loop below after debugging !!!
6526 C Calculate the dipole-dipole interaction energies
6527 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6528 do i=iatel_s,iatel_e+1
6529 num_conti=num_cont_hb(i)
6538 C Calculate the local-electrostatic correlation terms
6539 c write (iout,*) "gradcorr5 in eello5 before loop"
6541 c write (iout,'(i5,3f10.5)')
6542 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6544 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6545 c write (iout,*) "corr loop i",i
6547 num_conti=num_cont_hb(i)
6548 num_conti1=num_cont_hb(i+1)
6555 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6556 c & ' jj=',jj,' kk=',kk
6557 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6558 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6559 & .or. j.lt.0 .and. j1.gt.0) .and.
6560 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6561 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6562 C The system gains extra energy.
6564 sqd1=dsqrt(d_cont(jj,i))
6565 sqd2=dsqrt(d_cont(kk,i1))
6566 sred_geom = sqd1*sqd2
6567 IF (sred_geom.lt.cutoff_corr) THEN
6568 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6570 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6571 cd & ' jj=',jj,' kk=',kk
6572 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6573 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6575 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6576 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6579 cd write (iout,*) 'sred_geom=',sred_geom,
6580 cd & ' ekont=',ekont,' fprim=',fprimcont,
6581 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6582 cd write (iout,*) "g_contij",g_contij
6583 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6584 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6585 call calc_eello(i,jp,i+1,jp1,jj,kk)
6586 if (wcorr4.gt.0.0d0)
6587 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6588 CC & *fac_shield(i)**2*fac_shield(j)**2
6589 if (energy_dec.and.wcorr4.gt.0.0d0)
6590 1 write (iout,'(a6,4i5,0pf7.3)')
6591 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6592 c write (iout,*) "gradcorr5 before eello5"
6594 c write (iout,'(i5,3f10.5)')
6595 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6597 if (wcorr5.gt.0.0d0)
6598 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6599 c write (iout,*) "gradcorr5 after eello5"
6601 c write (iout,'(i5,3f10.5)')
6602 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6604 if (energy_dec.and.wcorr5.gt.0.0d0)
6605 1 write (iout,'(a6,4i5,0pf7.3)')
6606 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6607 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6608 cd write(2,*)'ijkl',i,jp,i+1,jp1
6609 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6610 & .or. wturn6.eq.0.0d0))then
6611 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6612 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6613 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6614 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6615 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6616 cd & 'ecorr6=',ecorr6
6617 cd write (iout,'(4e15.5)') sred_geom,
6618 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6619 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6620 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6621 else if (wturn6.gt.0.0d0
6622 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6623 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6624 eturn6=eturn6+eello_turn6(i,jj,kk)
6625 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6626 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6627 cd write (2,*) 'multibody_eello:eturn6',eturn6
6636 num_cont_hb(i)=num_cont_hb_old(i)
6638 c write (iout,*) "gradcorr5 in eello5"
6640 c write (iout,'(i5,3f10.5)')
6641 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6645 c------------------------------------------------------------------------------
6646 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6647 implicit real*8 (a-h,o-z)
6648 include 'DIMENSIONS'
6649 include 'DIMENSIONS.ZSCOPT'
6650 include 'COMMON.IOUNITS'
6651 include 'COMMON.DERIV'
6652 include 'COMMON.INTERACT'
6653 include 'COMMON.CONTACTS'
6654 include 'COMMON.SHIELD'
6655 include 'COMMON.CONTROL'
6656 double precision gx(3),gx1(3)
6659 C print *,"wchodze",fac_shield(i),shield_mode
6667 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6669 C & fac_shield(i)**2*fac_shield(j)**2
6670 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6671 C Following 4 lines for diagnostics.
6676 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6677 c & 'Contacts ',i,j,
6678 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6679 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6681 C Calculate the multi-body contribution to energy.
6682 C ecorr=ecorr+ekont*ees
6683 C Calculate multi-body contributions to the gradient.
6684 coeffpees0pij=coeffp*ees0pij
6685 coeffmees0mij=coeffm*ees0mij
6686 coeffpees0pkl=coeffp*ees0pkl
6687 coeffmees0mkl=coeffm*ees0mkl
6689 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6690 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6691 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6692 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6693 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6694 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6695 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6696 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6697 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6698 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6699 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6700 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6701 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6702 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6703 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6704 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6705 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6706 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6707 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6708 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6709 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6710 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6711 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6712 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6713 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6718 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6719 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6720 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6721 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6726 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6727 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6728 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6729 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6732 c write (iout,*) "ehbcorr",ekont*ees
6733 C print *,ekont,ees,i,k
6735 C now gradient over shielding
6737 if (shield_mode.gt.0) then
6740 C print *,i,j,fac_shield(i),fac_shield(j),
6741 C &fac_shield(k),fac_shield(l)
6742 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6743 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6744 do ilist=1,ishield_list(i)
6745 iresshield=shield_list(ilist,i)
6747 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6749 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6751 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6752 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6756 do ilist=1,ishield_list(j)
6757 iresshield=shield_list(ilist,j)
6759 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6761 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6763 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6764 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6769 do ilist=1,ishield_list(k)
6770 iresshield=shield_list(ilist,k)
6772 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6774 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6776 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6777 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6781 do ilist=1,ishield_list(l)
6782 iresshield=shield_list(ilist,l)
6784 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6786 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6788 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6789 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6793 C print *,gshieldx(m,iresshield)
6795 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6796 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6797 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6798 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6799 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6800 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6801 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6802 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6804 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6805 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6806 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6807 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6808 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6809 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6810 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6811 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6819 C---------------------------------------------------------------------------
6820 subroutine dipole(i,j,jj)
6821 implicit real*8 (a-h,o-z)
6822 include 'DIMENSIONS'
6823 include 'DIMENSIONS.ZSCOPT'
6824 include 'COMMON.IOUNITS'
6825 include 'COMMON.CHAIN'
6826 include 'COMMON.FFIELD'
6827 include 'COMMON.DERIV'
6828 include 'COMMON.INTERACT'
6829 include 'COMMON.CONTACTS'
6830 include 'COMMON.TORSION'
6831 include 'COMMON.VAR'
6832 include 'COMMON.GEO'
6833 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6835 iti1 = itortyp(itype(i+1))
6836 if (j.lt.nres-1) then
6837 itj1 = itype2loc(itype(j+1))
6842 dipi(iii,1)=Ub2(iii,i)
6843 dipderi(iii)=Ub2der(iii,i)
6844 dipi(iii,2)=b1(iii,i+1)
6845 dipj(iii,1)=Ub2(iii,j)
6846 dipderj(iii)=Ub2der(iii,j)
6847 dipj(iii,2)=b1(iii,j+1)
6851 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6854 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6861 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6865 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6870 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6871 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6873 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6875 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6877 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6882 C---------------------------------------------------------------------------
6883 subroutine calc_eello(i,j,k,l,jj,kk)
6885 C This subroutine computes matrices and vectors needed to calculate
6886 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6888 implicit real*8 (a-h,o-z)
6889 include 'DIMENSIONS'
6890 include 'DIMENSIONS.ZSCOPT'
6891 include 'COMMON.IOUNITS'
6892 include 'COMMON.CHAIN'
6893 include 'COMMON.DERIV'
6894 include 'COMMON.INTERACT'
6895 include 'COMMON.CONTACTS'
6896 include 'COMMON.TORSION'
6897 include 'COMMON.VAR'
6898 include 'COMMON.GEO'
6899 include 'COMMON.FFIELD'
6900 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6901 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6904 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6905 cd & ' jj=',jj,' kk=',kk
6906 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6907 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6908 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6911 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6912 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6915 call transpose2(aa1(1,1),aa1t(1,1))
6916 call transpose2(aa2(1,1),aa2t(1,1))
6919 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6920 & aa1tder(1,1,lll,kkk))
6921 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6922 & aa2tder(1,1,lll,kkk))
6926 C parallel orientation of the two CA-CA-CA frames.
6928 iti=itype2loc(itype(i))
6932 itk1=itype2loc(itype(k+1))
6933 itj=itype2loc(itype(j))
6934 if (l.lt.nres-1) then
6935 itl1=itype2loc(itype(l+1))
6939 C A1 kernel(j+1) A2T
6941 cd write (iout,'(3f10.5,5x,3f10.5)')
6942 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6944 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6945 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6946 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6947 C Following matrices are needed only for 6-th order cumulants
6948 IF (wcorr6.gt.0.0d0) THEN
6949 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6950 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6951 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6952 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6953 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6954 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6955 & ADtEAderx(1,1,1,1,1,1))
6957 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6958 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6959 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6960 & ADtEA1derx(1,1,1,1,1,1))
6962 C End 6-th order cumulants
6965 cd write (2,*) 'In calc_eello6'
6967 cd write (2,*) 'iii=',iii
6969 cd write (2,*) 'kkk=',kkk
6971 cd write (2,'(3(2f10.5),5x)')
6972 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6977 call transpose2(EUgder(1,1,k),auxmat(1,1))
6978 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6979 call transpose2(EUg(1,1,k),auxmat(1,1))
6980 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6981 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6985 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6986 & EAEAderx(1,1,lll,kkk,iii,1))
6990 C A1T kernel(i+1) A2
6991 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6992 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6993 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6994 C Following matrices are needed only for 6-th order cumulants
6995 IF (wcorr6.gt.0.0d0) THEN
6996 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6997 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6998 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6999 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7000 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7001 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7002 & ADtEAderx(1,1,1,1,1,2))
7003 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7004 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7005 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7006 & ADtEA1derx(1,1,1,1,1,2))
7008 C End 6-th order cumulants
7009 call transpose2(EUgder(1,1,l),auxmat(1,1))
7010 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7011 call transpose2(EUg(1,1,l),auxmat(1,1))
7012 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7013 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7017 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7018 & EAEAderx(1,1,lll,kkk,iii,2))
7023 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7024 C They are needed only when the fifth- or the sixth-order cumulants are
7026 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7027 call transpose2(AEA(1,1,1),auxmat(1,1))
7028 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7029 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7030 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7031 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7032 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7033 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7034 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7035 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7036 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7037 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7038 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7039 call transpose2(AEA(1,1,2),auxmat(1,1))
7040 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7041 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7042 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7043 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7044 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7045 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7046 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7047 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7048 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7049 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7050 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7051 C Calculate the Cartesian derivatives of the vectors.
7055 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7056 call matvec2(auxmat(1,1),b1(1,i),
7057 & AEAb1derx(1,lll,kkk,iii,1,1))
7058 call matvec2(auxmat(1,1),Ub2(1,i),
7059 & AEAb2derx(1,lll,kkk,iii,1,1))
7060 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7061 & AEAb1derx(1,lll,kkk,iii,2,1))
7062 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7063 & AEAb2derx(1,lll,kkk,iii,2,1))
7064 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7065 call matvec2(auxmat(1,1),b1(1,j),
7066 & AEAb1derx(1,lll,kkk,iii,1,2))
7067 call matvec2(auxmat(1,1),Ub2(1,j),
7068 & AEAb2derx(1,lll,kkk,iii,1,2))
7069 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7070 & AEAb1derx(1,lll,kkk,iii,2,2))
7071 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7072 & AEAb2derx(1,lll,kkk,iii,2,2))
7079 C Antiparallel orientation of the two CA-CA-CA frames.
7081 iti=itype2loc(itype(i))
7085 itk1=itype2loc(itype(k+1))
7086 itl=itype2loc(itype(l))
7087 itj=itype2loc(itype(j))
7088 if (j.lt.nres-1) then
7089 itj1=itype2loc(itype(j+1))
7093 C A2 kernel(j-1)T A1T
7094 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7095 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7096 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7097 C Following matrices are needed only for 6-th order cumulants
7098 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7099 & j.eq.i+4 .and. l.eq.i+3)) THEN
7100 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7101 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7102 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7103 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7104 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7105 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7106 & ADtEAderx(1,1,1,1,1,1))
7107 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7108 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7109 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7110 & ADtEA1derx(1,1,1,1,1,1))
7112 C End 6-th order cumulants
7113 call transpose2(EUgder(1,1,k),auxmat(1,1))
7114 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7115 call transpose2(EUg(1,1,k),auxmat(1,1))
7116 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7117 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7121 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7122 & EAEAderx(1,1,lll,kkk,iii,1))
7126 C A2T kernel(i+1)T A1
7127 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7128 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7129 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7130 C Following matrices are needed only for 6-th order cumulants
7131 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7132 & j.eq.i+4 .and. l.eq.i+3)) THEN
7133 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7134 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7135 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7136 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7137 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7138 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7139 & ADtEAderx(1,1,1,1,1,2))
7140 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7141 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7142 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7143 & ADtEA1derx(1,1,1,1,1,2))
7145 C End 6-th order cumulants
7146 call transpose2(EUgder(1,1,j),auxmat(1,1))
7147 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7148 call transpose2(EUg(1,1,j),auxmat(1,1))
7149 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7150 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7154 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7155 & EAEAderx(1,1,lll,kkk,iii,2))
7160 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7161 C They are needed only when the fifth- or the sixth-order cumulants are
7163 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7164 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7165 call transpose2(AEA(1,1,1),auxmat(1,1))
7166 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7167 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7168 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7169 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7170 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7171 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7172 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7173 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7174 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7175 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7176 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7177 call transpose2(AEA(1,1,2),auxmat(1,1))
7178 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7179 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7180 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7181 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7182 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7183 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7184 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7185 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7186 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7187 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7188 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7189 C Calculate the Cartesian derivatives of the vectors.
7193 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7194 call matvec2(auxmat(1,1),b1(1,i),
7195 & AEAb1derx(1,lll,kkk,iii,1,1))
7196 call matvec2(auxmat(1,1),Ub2(1,i),
7197 & AEAb2derx(1,lll,kkk,iii,1,1))
7198 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7199 & AEAb1derx(1,lll,kkk,iii,2,1))
7200 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7201 & AEAb2derx(1,lll,kkk,iii,2,1))
7202 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7203 call matvec2(auxmat(1,1),b1(1,l),
7204 & AEAb1derx(1,lll,kkk,iii,1,2))
7205 call matvec2(auxmat(1,1),Ub2(1,l),
7206 & AEAb2derx(1,lll,kkk,iii,1,2))
7207 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7208 & AEAb1derx(1,lll,kkk,iii,2,2))
7209 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7210 & AEAb2derx(1,lll,kkk,iii,2,2))
7219 C---------------------------------------------------------------------------
7220 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7221 & KK,KKderg,AKA,AKAderg,AKAderx)
7225 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7226 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7227 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7232 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7234 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7237 cd if (lprn) write (2,*) 'In kernel'
7239 cd if (lprn) write (2,*) 'kkk=',kkk
7241 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7242 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7244 cd write (2,*) 'lll=',lll
7245 cd write (2,*) 'iii=1'
7247 cd write (2,'(3(2f10.5),5x)')
7248 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7251 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7252 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7254 cd write (2,*) 'lll=',lll
7255 cd write (2,*) 'iii=2'
7257 cd write (2,'(3(2f10.5),5x)')
7258 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7265 C---------------------------------------------------------------------------
7266 double precision function eello4(i,j,k,l,jj,kk)
7267 implicit real*8 (a-h,o-z)
7268 include 'DIMENSIONS'
7269 include 'DIMENSIONS.ZSCOPT'
7270 include 'COMMON.IOUNITS'
7271 include 'COMMON.CHAIN'
7272 include 'COMMON.DERIV'
7273 include 'COMMON.INTERACT'
7274 include 'COMMON.CONTACTS'
7275 include 'COMMON.TORSION'
7276 include 'COMMON.VAR'
7277 include 'COMMON.GEO'
7278 double precision pizda(2,2),ggg1(3),ggg2(3)
7279 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7283 cd print *,'eello4:',i,j,k,l,jj,kk
7284 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7285 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7286 cold eij=facont_hb(jj,i)
7287 cold ekl=facont_hb(kk,k)
7289 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7291 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7292 gcorr_loc(k-1)=gcorr_loc(k-1)
7293 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7295 gcorr_loc(l-1)=gcorr_loc(l-1)
7296 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7298 gcorr_loc(j-1)=gcorr_loc(j-1)
7299 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7304 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7305 & -EAEAderx(2,2,lll,kkk,iii,1)
7306 cd derx(lll,kkk,iii)=0.0d0
7310 cd gcorr_loc(l-1)=0.0d0
7311 cd gcorr_loc(j-1)=0.0d0
7312 cd gcorr_loc(k-1)=0.0d0
7314 cd write (iout,*)'Contacts have occurred for peptide groups',
7315 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7316 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7317 if (j.lt.nres-1) then
7324 if (l.lt.nres-1) then
7332 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7333 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7334 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7335 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7336 cgrad ghalf=0.5d0*ggg1(ll)
7337 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7338 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7339 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7340 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7341 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7342 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7343 cgrad ghalf=0.5d0*ggg2(ll)
7344 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7345 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7346 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7347 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7348 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7349 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7353 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7358 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7363 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7368 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7372 cd write (2,*) iii,gcorr_loc(iii)
7376 cd write (2,*) 'ekont',ekont
7377 cd write (iout,*) 'eello4',ekont*eel4
7380 C---------------------------------------------------------------------------
7381 double precision function eello5(i,j,k,l,jj,kk)
7382 implicit real*8 (a-h,o-z)
7383 include 'DIMENSIONS'
7384 include 'DIMENSIONS.ZSCOPT'
7385 include 'COMMON.IOUNITS'
7386 include 'COMMON.CHAIN'
7387 include 'COMMON.DERIV'
7388 include 'COMMON.INTERACT'
7389 include 'COMMON.CONTACTS'
7390 include 'COMMON.TORSION'
7391 include 'COMMON.VAR'
7392 include 'COMMON.GEO'
7393 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7394 double precision ggg1(3),ggg2(3)
7395 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7400 C /l\ / \ \ / \ / \ / C
7401 C / \ / \ \ / \ / \ / C
7402 C j| o |l1 | o | o| o | | o |o C
7403 C \ |/k\| |/ \| / |/ \| |/ \| C
7404 C \i/ \ / \ / / \ / \ C
7406 C (I) (II) (III) (IV) C
7408 C eello5_1 eello5_2 eello5_3 eello5_4 C
7410 C Antiparallel chains C
7413 C /j\ / \ \ / \ / \ / C
7414 C / \ / \ \ / \ / \ / C
7415 C j1| o |l | o | o| o | | o |o C
7416 C \ |/k\| |/ \| / |/ \| |/ \| C
7417 C \i/ \ / \ / / \ / \ C
7419 C (I) (II) (III) (IV) C
7421 C eello5_1 eello5_2 eello5_3 eello5_4 C
7423 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7425 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7426 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7431 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7433 itk=itype2loc(itype(k))
7434 itl=itype2loc(itype(l))
7435 itj=itype2loc(itype(j))
7440 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7441 cd & eel5_3_num,eel5_4_num)
7445 derx(lll,kkk,iii)=0.0d0
7449 cd eij=facont_hb(jj,i)
7450 cd ekl=facont_hb(kk,k)
7452 cd write (iout,*)'Contacts have occurred for peptide groups',
7453 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7455 C Contribution from the graph I.
7456 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7457 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7458 call transpose2(EUg(1,1,k),auxmat(1,1))
7459 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7460 vv(1)=pizda(1,1)-pizda(2,2)
7461 vv(2)=pizda(1,2)+pizda(2,1)
7462 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7463 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7465 C Explicit gradient in virtual-dihedral angles.
7466 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7467 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7468 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7469 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7470 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7471 vv(1)=pizda(1,1)-pizda(2,2)
7472 vv(2)=pizda(1,2)+pizda(2,1)
7473 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7474 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7475 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7476 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7477 vv(1)=pizda(1,1)-pizda(2,2)
7478 vv(2)=pizda(1,2)+pizda(2,1)
7480 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7481 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7482 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7484 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7485 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7486 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7488 C Cartesian gradient
7492 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7494 vv(1)=pizda(1,1)-pizda(2,2)
7495 vv(2)=pizda(1,2)+pizda(2,1)
7496 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7497 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7498 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7505 C Contribution from graph II
7506 call transpose2(EE(1,1,k),auxmat(1,1))
7507 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7508 vv(1)=pizda(1,1)+pizda(2,2)
7509 vv(2)=pizda(2,1)-pizda(1,2)
7510 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7511 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7513 C Explicit gradient in virtual-dihedral angles.
7514 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7515 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7516 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7517 vv(1)=pizda(1,1)+pizda(2,2)
7518 vv(2)=pizda(2,1)-pizda(1,2)
7520 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7521 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7522 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7524 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7525 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7526 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7528 C Cartesian gradient
7532 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7534 vv(1)=pizda(1,1)+pizda(2,2)
7535 vv(2)=pizda(2,1)-pizda(1,2)
7536 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7537 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7538 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7547 C Parallel orientation
7548 C Contribution from graph III
7549 call transpose2(EUg(1,1,l),auxmat(1,1))
7550 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7551 vv(1)=pizda(1,1)-pizda(2,2)
7552 vv(2)=pizda(1,2)+pizda(2,1)
7553 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7554 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7556 C Explicit gradient in virtual-dihedral angles.
7557 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7558 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7559 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7560 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7561 vv(1)=pizda(1,1)-pizda(2,2)
7562 vv(2)=pizda(1,2)+pizda(2,1)
7563 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7564 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7565 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7566 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7567 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7568 vv(1)=pizda(1,1)-pizda(2,2)
7569 vv(2)=pizda(1,2)+pizda(2,1)
7570 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7571 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7572 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7573 C Cartesian gradient
7577 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7579 vv(1)=pizda(1,1)-pizda(2,2)
7580 vv(2)=pizda(1,2)+pizda(2,1)
7581 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7582 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7583 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7588 C Contribution from graph IV
7590 call transpose2(EE(1,1,l),auxmat(1,1))
7591 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7592 vv(1)=pizda(1,1)+pizda(2,2)
7593 vv(2)=pizda(2,1)-pizda(1,2)
7594 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7595 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7596 C Explicit gradient in virtual-dihedral angles.
7597 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7598 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7599 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7600 vv(1)=pizda(1,1)+pizda(2,2)
7601 vv(2)=pizda(2,1)-pizda(1,2)
7602 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7603 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7604 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7605 C Cartesian gradient
7609 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7611 vv(1)=pizda(1,1)+pizda(2,2)
7612 vv(2)=pizda(2,1)-pizda(1,2)
7613 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7614 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7615 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7621 C Antiparallel orientation
7622 C Contribution from graph III
7624 call transpose2(EUg(1,1,j),auxmat(1,1))
7625 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7626 vv(1)=pizda(1,1)-pizda(2,2)
7627 vv(2)=pizda(1,2)+pizda(2,1)
7628 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7629 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7631 C Explicit gradient in virtual-dihedral angles.
7632 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7633 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7634 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7635 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7636 vv(1)=pizda(1,1)-pizda(2,2)
7637 vv(2)=pizda(1,2)+pizda(2,1)
7638 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7639 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7640 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7641 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7642 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7643 vv(1)=pizda(1,1)-pizda(2,2)
7644 vv(2)=pizda(1,2)+pizda(2,1)
7645 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7646 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7647 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7648 C Cartesian gradient
7652 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7654 vv(1)=pizda(1,1)-pizda(2,2)
7655 vv(2)=pizda(1,2)+pizda(2,1)
7656 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7657 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7658 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7664 C Contribution from graph IV
7666 call transpose2(EE(1,1,j),auxmat(1,1))
7667 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7668 vv(1)=pizda(1,1)+pizda(2,2)
7669 vv(2)=pizda(2,1)-pizda(1,2)
7670 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7671 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7673 C Explicit gradient in virtual-dihedral angles.
7674 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7675 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7676 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7677 vv(1)=pizda(1,1)+pizda(2,2)
7678 vv(2)=pizda(2,1)-pizda(1,2)
7679 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7680 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7681 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7682 C Cartesian gradient
7686 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7688 vv(1)=pizda(1,1)+pizda(2,2)
7689 vv(2)=pizda(2,1)-pizda(1,2)
7690 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7691 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7692 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7699 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7700 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7701 cd write (2,*) 'ijkl',i,j,k,l
7702 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7703 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7705 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7706 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7707 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7708 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7710 if (j.lt.nres-1) then
7717 if (l.lt.nres-1) then
7727 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7728 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7729 C summed up outside the subrouine as for the other subroutines
7730 C handling long-range interactions. The old code is commented out
7731 C with "cgrad" to keep track of changes.
7733 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7734 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7735 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7736 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7737 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7738 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7739 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7740 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7741 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7742 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7744 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7745 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7746 cgrad ghalf=0.5d0*ggg1(ll)
7748 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7749 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7750 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7751 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7752 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7753 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7754 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7755 cgrad ghalf=0.5d0*ggg2(ll)
7757 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7758 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7759 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7760 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7761 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7762 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7768 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7769 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7774 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7775 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7781 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7786 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7790 cd write (2,*) iii,g_corr5_loc(iii)
7793 cd write (2,*) 'ekont',ekont
7794 cd write (iout,*) 'eello5',ekont*eel5
7797 c--------------------------------------------------------------------------
7798 double precision function eello6(i,j,k,l,jj,kk)
7799 implicit real*8 (a-h,o-z)
7800 include 'DIMENSIONS'
7801 include 'DIMENSIONS.ZSCOPT'
7802 include 'COMMON.IOUNITS'
7803 include 'COMMON.CHAIN'
7804 include 'COMMON.DERIV'
7805 include 'COMMON.INTERACT'
7806 include 'COMMON.CONTACTS'
7807 include 'COMMON.TORSION'
7808 include 'COMMON.VAR'
7809 include 'COMMON.GEO'
7810 include 'COMMON.FFIELD'
7811 double precision ggg1(3),ggg2(3)
7812 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7817 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7825 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7826 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7830 derx(lll,kkk,iii)=0.0d0
7834 cd eij=facont_hb(jj,i)
7835 cd ekl=facont_hb(kk,k)
7841 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7842 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7843 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7844 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7845 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7846 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7848 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7849 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7850 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7851 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7852 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7853 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7857 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7859 C If turn contributions are considered, they will be handled separately.
7860 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7861 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7862 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7863 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7864 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7865 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7866 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7869 if (j.lt.nres-1) then
7876 if (l.lt.nres-1) then
7884 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7885 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7886 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7887 cgrad ghalf=0.5d0*ggg1(ll)
7889 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7890 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7891 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7892 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7893 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7894 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7895 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7896 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7897 cgrad ghalf=0.5d0*ggg2(ll)
7898 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7900 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7901 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7902 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7903 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7904 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7905 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7911 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7912 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7917 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7918 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7924 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7929 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7933 cd write (2,*) iii,g_corr6_loc(iii)
7936 cd write (2,*) 'ekont',ekont
7937 cd write (iout,*) 'eello6',ekont*eel6
7940 c--------------------------------------------------------------------------
7941 double precision function eello6_graph1(i,j,k,l,imat,swap)
7942 implicit real*8 (a-h,o-z)
7943 include 'DIMENSIONS'
7944 include 'DIMENSIONS.ZSCOPT'
7945 include 'COMMON.IOUNITS'
7946 include 'COMMON.CHAIN'
7947 include 'COMMON.DERIV'
7948 include 'COMMON.INTERACT'
7949 include 'COMMON.CONTACTS'
7950 include 'COMMON.TORSION'
7951 include 'COMMON.VAR'
7952 include 'COMMON.GEO'
7953 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7957 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7959 C Parallel Antiparallel C
7965 C \ j|/k\| / \ |/k\|l / C
7970 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7971 itk=itype2loc(itype(k))
7972 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7973 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7974 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7975 call transpose2(EUgC(1,1,k),auxmat(1,1))
7976 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7977 vv1(1)=pizda1(1,1)-pizda1(2,2)
7978 vv1(2)=pizda1(1,2)+pizda1(2,1)
7979 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7980 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
7981 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
7982 s5=scalar2(vv(1),Dtobr2(1,i))
7983 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7984 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7986 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7987 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7988 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7989 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7990 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7991 & +scalar2(vv(1),Dtobr2der(1,i)))
7992 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7993 vv1(1)=pizda1(1,1)-pizda1(2,2)
7994 vv1(2)=pizda1(1,2)+pizda1(2,1)
7995 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
7996 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
7998 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7999 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8000 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8001 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8002 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8004 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8005 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8006 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8007 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8008 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8010 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8011 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8012 vv1(1)=pizda1(1,1)-pizda1(2,2)
8013 vv1(2)=pizda1(1,2)+pizda1(2,1)
8014 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8015 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8016 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8017 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8026 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8027 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8028 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8029 call transpose2(EUgC(1,1,k),auxmat(1,1))
8030 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8032 vv1(1)=pizda1(1,1)-pizda1(2,2)
8033 vv1(2)=pizda1(1,2)+pizda1(2,1)
8034 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8035 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8036 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8037 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8038 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8039 s5=scalar2(vv(1),Dtobr2(1,i))
8040 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8047 c----------------------------------------------------------------------------
8048 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8049 implicit real*8 (a-h,o-z)
8050 include 'DIMENSIONS'
8051 include 'DIMENSIONS.ZSCOPT'
8052 include 'COMMON.IOUNITS'
8053 include 'COMMON.CHAIN'
8054 include 'COMMON.DERIV'
8055 include 'COMMON.INTERACT'
8056 include 'COMMON.CONTACTS'
8057 include 'COMMON.TORSION'
8058 include 'COMMON.VAR'
8059 include 'COMMON.GEO'
8061 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8062 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8065 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8067 C Parallel Antiparallel C
8073 C \ j|/k\| \ |/k\|l C
8078 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8079 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8080 C AL 7/4/01 s1 would occur in the sixth-order moment,
8081 C but not in a cluster cumulant
8083 s1=dip(1,jj,i)*dip(1,kk,k)
8085 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8086 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8087 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8088 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8089 call transpose2(EUg(1,1,k),auxmat(1,1))
8090 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8091 vv(1)=pizda(1,1)-pizda(2,2)
8092 vv(2)=pizda(1,2)+pizda(2,1)
8093 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8094 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8096 eello6_graph2=-(s1+s2+s3+s4)
8098 eello6_graph2=-(s2+s3+s4)
8101 C Derivatives in gamma(i-1)
8105 s1=dipderg(1,jj,i)*dip(1,kk,k)
8107 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8108 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8109 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8110 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8112 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8114 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8116 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8118 C Derivatives in gamma(k-1)
8120 s1=dip(1,jj,i)*dipderg(1,kk,k)
8122 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8123 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8124 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8125 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8126 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8127 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8128 vv(1)=pizda(1,1)-pizda(2,2)
8129 vv(2)=pizda(1,2)+pizda(2,1)
8130 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8132 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8134 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8136 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8137 C Derivatives in gamma(j-1) or gamma(l-1)
8140 s1=dipderg(3,jj,i)*dip(1,kk,k)
8142 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8143 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8144 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8145 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8146 vv(1)=pizda(1,1)-pizda(2,2)
8147 vv(2)=pizda(1,2)+pizda(2,1)
8148 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8151 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8153 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8156 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8157 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8159 C Derivatives in gamma(l-1) or gamma(j-1)
8162 s1=dip(1,jj,i)*dipderg(3,kk,k)
8164 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8165 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8166 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8167 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8168 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8169 vv(1)=pizda(1,1)-pizda(2,2)
8170 vv(2)=pizda(1,2)+pizda(2,1)
8171 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8174 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8176 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8179 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8180 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8182 C Cartesian derivatives.
8184 write (2,*) 'In eello6_graph2'
8186 write (2,*) 'iii=',iii
8188 write (2,*) 'kkk=',kkk
8190 write (2,'(3(2f10.5),5x)')
8191 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8201 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8203 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8206 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8208 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8209 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8211 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8212 call transpose2(EUg(1,1,k),auxmat(1,1))
8213 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8215 vv(1)=pizda(1,1)-pizda(2,2)
8216 vv(2)=pizda(1,2)+pizda(2,1)
8217 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8218 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8220 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8222 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8225 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8227 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8235 c----------------------------------------------------------------------------
8236 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8237 implicit real*8 (a-h,o-z)
8238 include 'DIMENSIONS'
8239 include 'DIMENSIONS.ZSCOPT'
8240 include 'COMMON.IOUNITS'
8241 include 'COMMON.CHAIN'
8242 include 'COMMON.DERIV'
8243 include 'COMMON.INTERACT'
8244 include 'COMMON.CONTACTS'
8245 include 'COMMON.TORSION'
8246 include 'COMMON.VAR'
8247 include 'COMMON.GEO'
8248 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8250 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8252 C Parallel Antiparallel C
8258 C j|/k\| / |/k\|l / C
8263 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8265 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8266 C energy moment and not to the cluster cumulant.
8267 iti=itortyp(itype(i))
8268 if (j.lt.nres-1) then
8269 itj1=itype2loc(itype(j+1))
8273 itk=itype2loc(itype(k))
8274 itk1=itype2loc(itype(k+1))
8275 if (l.lt.nres-1) then
8276 itl1=itype2loc(itype(l+1))
8281 s1=dip(4,jj,i)*dip(4,kk,k)
8283 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8284 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8285 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8286 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8287 call transpose2(EE(1,1,k),auxmat(1,1))
8288 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8289 vv(1)=pizda(1,1)+pizda(2,2)
8290 vv(2)=pizda(2,1)-pizda(1,2)
8291 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8292 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8293 cd & "sum",-(s2+s3+s4)
8295 eello6_graph3=-(s1+s2+s3+s4)
8297 eello6_graph3=-(s2+s3+s4)
8300 C Derivatives in gamma(k-1)
8302 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8303 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8304 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8305 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8306 C Derivatives in gamma(l-1)
8307 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8308 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8309 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8310 vv(1)=pizda(1,1)+pizda(2,2)
8311 vv(2)=pizda(2,1)-pizda(1,2)
8312 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8313 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8314 C Cartesian derivatives.
8320 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8322 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8325 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8327 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8328 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8330 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8331 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8333 vv(1)=pizda(1,1)+pizda(2,2)
8334 vv(2)=pizda(2,1)-pizda(1,2)
8335 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8337 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8339 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8342 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8344 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8346 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8353 c----------------------------------------------------------------------------
8354 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8355 implicit real*8 (a-h,o-z)
8356 include 'DIMENSIONS'
8357 include 'DIMENSIONS.ZSCOPT'
8358 include 'COMMON.IOUNITS'
8359 include 'COMMON.CHAIN'
8360 include 'COMMON.DERIV'
8361 include 'COMMON.INTERACT'
8362 include 'COMMON.CONTACTS'
8363 include 'COMMON.TORSION'
8364 include 'COMMON.VAR'
8365 include 'COMMON.GEO'
8366 include 'COMMON.FFIELD'
8367 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8368 & auxvec1(2),auxmat1(2,2)
8370 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8372 C Parallel Antiparallel C
8378 C \ j|/k\| \ |/k\|l C
8383 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8385 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8386 C energy moment and not to the cluster cumulant.
8387 cd write (2,*) 'eello_graph4: wturn6',wturn6
8388 iti=itype2loc(itype(i))
8389 itj=itype2loc(itype(j))
8390 if (j.lt.nres-1) then
8391 itj1=itype2loc(itype(j+1))
8395 itk=itype2loc(itype(k))
8396 if (k.lt.nres-1) then
8397 itk1=itype2loc(itype(k+1))
8401 itl=itype2loc(itype(l))
8402 if (l.lt.nres-1) then
8403 itl1=itype2loc(itype(l+1))
8407 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8408 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8409 cd & ' itl',itl,' itl1',itl1
8412 s1=dip(3,jj,i)*dip(3,kk,k)
8414 s1=dip(2,jj,j)*dip(2,kk,l)
8417 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8418 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8420 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8421 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8423 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8424 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8426 call transpose2(EUg(1,1,k),auxmat(1,1))
8427 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8428 vv(1)=pizda(1,1)-pizda(2,2)
8429 vv(2)=pizda(2,1)+pizda(1,2)
8430 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8431 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8433 eello6_graph4=-(s1+s2+s3+s4)
8435 eello6_graph4=-(s2+s3+s4)
8437 C Derivatives in gamma(i-1)
8442 s1=dipderg(2,jj,i)*dip(3,kk,k)
8444 s1=dipderg(4,jj,j)*dip(2,kk,l)
8447 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8449 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8450 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8452 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8453 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8455 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8456 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8457 cd write (2,*) 'turn6 derivatives'
8459 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8461 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8465 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8467 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8471 C Derivatives in gamma(k-1)
8474 s1=dip(3,jj,i)*dipderg(2,kk,k)
8476 s1=dip(2,jj,j)*dipderg(4,kk,l)
8479 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8480 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8482 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8483 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8485 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8486 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8488 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8489 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8490 vv(1)=pizda(1,1)-pizda(2,2)
8491 vv(2)=pizda(2,1)+pizda(1,2)
8492 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8493 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8495 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8497 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8501 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8503 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8506 C Derivatives in gamma(j-1) or gamma(l-1)
8507 if (l.eq.j+1 .and. l.gt.1) then
8508 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8509 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8510 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8511 vv(1)=pizda(1,1)-pizda(2,2)
8512 vv(2)=pizda(2,1)+pizda(1,2)
8513 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8514 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8515 else if (j.gt.1) then
8516 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8517 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8518 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8519 vv(1)=pizda(1,1)-pizda(2,2)
8520 vv(2)=pizda(2,1)+pizda(1,2)
8521 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8522 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8523 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8525 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8528 C Cartesian derivatives.
8535 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8537 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8541 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8543 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8547 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8549 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8551 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8552 & b1(1,j+1),auxvec(1))
8553 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8555 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8556 & b1(1,l+1),auxvec(1))
8557 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8559 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8561 vv(1)=pizda(1,1)-pizda(2,2)
8562 vv(2)=pizda(2,1)+pizda(1,2)
8563 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8565 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8567 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8570 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8573 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8576 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8578 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8580 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8584 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8586 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8589 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8591 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8600 c----------------------------------------------------------------------------
8601 double precision function eello_turn6(i,jj,kk)
8602 implicit real*8 (a-h,o-z)
8603 include 'DIMENSIONS'
8604 include 'DIMENSIONS.ZSCOPT'
8605 include 'COMMON.IOUNITS'
8606 include 'COMMON.CHAIN'
8607 include 'COMMON.DERIV'
8608 include 'COMMON.INTERACT'
8609 include 'COMMON.CONTACTS'
8610 include 'COMMON.TORSION'
8611 include 'COMMON.VAR'
8612 include 'COMMON.GEO'
8613 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8614 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8616 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8617 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8618 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8619 C the respective energy moment and not to the cluster cumulant.
8628 iti=itype2loc(itype(i))
8629 itk=itype2loc(itype(k))
8630 itk1=itype2loc(itype(k+1))
8631 itl=itype2loc(itype(l))
8632 itj=itype2loc(itype(j))
8633 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8634 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8635 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8640 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8642 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8646 derx_turn(lll,kkk,iii)=0.0d0
8653 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8655 cd write (2,*) 'eello6_5',eello6_5
8657 call transpose2(AEA(1,1,1),auxmat(1,1))
8658 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8659 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8660 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8662 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8663 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8664 s2 = scalar2(b1(1,k),vtemp1(1))
8666 call transpose2(AEA(1,1,2),atemp(1,1))
8667 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8668 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8669 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8671 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8672 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8673 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8675 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8676 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8677 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8678 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8679 ss13 = scalar2(b1(1,k),vtemp4(1))
8680 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8682 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8688 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8689 C Derivatives in gamma(i+2)
8694 call transpose2(AEA(1,1,1),auxmatd(1,1))
8695 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8696 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8697 call transpose2(AEAderg(1,1,2),atempd(1,1))
8698 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8699 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8701 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8702 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8703 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8709 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8710 C Derivatives in gamma(i+3)
8712 call transpose2(AEA(1,1,1),auxmatd(1,1))
8713 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8714 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8715 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8717 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8718 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8719 s2d = scalar2(b1(1,k),vtemp1d(1))
8721 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8722 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8724 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8726 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8727 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8728 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8736 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8737 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8739 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8740 & -0.5d0*ekont*(s2d+s12d)
8742 C Derivatives in gamma(i+4)
8743 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8744 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8745 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8747 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8748 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8749 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8757 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8759 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8761 C Derivatives in gamma(i+5)
8763 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8764 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8765 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8767 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8768 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8769 s2d = scalar2(b1(1,k),vtemp1d(1))
8771 call transpose2(AEA(1,1,2),atempd(1,1))
8772 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8773 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8775 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8776 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8778 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8779 ss13d = scalar2(b1(1,k),vtemp4d(1))
8780 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8788 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8789 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8791 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8792 & -0.5d0*ekont*(s2d+s12d)
8794 C Cartesian derivatives
8799 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8800 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8801 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8803 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8804 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8806 s2d = scalar2(b1(1,k),vtemp1d(1))
8808 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8809 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8810 s8d = -(atempd(1,1)+atempd(2,2))*
8811 & scalar2(cc(1,1,l),vtemp2(1))
8813 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8815 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8816 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8823 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8826 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8830 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8831 & - 0.5d0*(s8d+s12d)
8833 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8842 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8844 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8845 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8846 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8847 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8848 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8850 ss13d = scalar2(b1(1,k),vtemp4d(1))
8851 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8852 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8856 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8857 cd & 16*eel_turn6_num
8859 if (j.lt.nres-1) then
8866 if (l.lt.nres-1) then
8874 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8875 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8876 cgrad ghalf=0.5d0*ggg1(ll)
8878 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8879 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8880 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8881 & +ekont*derx_turn(ll,2,1)
8882 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8883 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8884 & +ekont*derx_turn(ll,4,1)
8885 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8886 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8887 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8888 cgrad ghalf=0.5d0*ggg2(ll)
8890 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8891 & +ekont*derx_turn(ll,2,2)
8892 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8893 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8894 & +ekont*derx_turn(ll,4,2)
8895 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8896 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8897 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8902 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8907 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8913 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8918 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8922 cd write (2,*) iii,g_corr6_loc(iii)
8925 eello_turn6=ekont*eel_turn6
8926 cd write (2,*) 'ekont',ekont
8927 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8931 crc-------------------------------------------------
8932 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8933 subroutine Eliptransfer(eliptran)
8934 implicit real*8 (a-h,o-z)
8935 include 'DIMENSIONS'
8936 include 'DIMENSIONS.ZSCOPT'
8937 include 'COMMON.GEO'
8938 include 'COMMON.VAR'
8939 include 'COMMON.LOCAL'
8940 include 'COMMON.CHAIN'
8941 include 'COMMON.DERIV'
8942 include 'COMMON.INTERACT'
8943 include 'COMMON.IOUNITS'
8944 include 'COMMON.CALC'
8945 include 'COMMON.CONTROL'
8946 include 'COMMON.SPLITELE'
8947 include 'COMMON.SBRIDGE'
8948 C this is done by Adasko
8952 C--bordliptop-- buffore starts
8953 C--bufliptop--- here true lipid starts
8955 C--buflipbot--- lipid ends buffore starts
8956 C--bordlipbot--buffore ends
8960 if (itype(i).eq.ntyp1) cycle
8962 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8963 if (positi.le.0) positi=positi+boxzsize
8965 C first for peptide groups
8966 c for each residue check if it is in lipid or lipid water border area
8967 if ((positi.gt.bordlipbot)
8968 &.and.(positi.lt.bordliptop)) then
8969 C the energy transfer exist
8970 if (positi.lt.buflipbot) then
8971 C what fraction I am in
8973 & ((positi-bordlipbot)/lipbufthick)
8974 C lipbufthick is thickenes of lipid buffore
8975 sslip=sscalelip(fracinbuf)
8976 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8977 eliptran=eliptran+sslip*pepliptran
8978 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8979 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8980 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8981 elseif (positi.gt.bufliptop) then
8982 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8983 sslip=sscalelip(fracinbuf)
8984 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8985 eliptran=eliptran+sslip*pepliptran
8986 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8987 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8988 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8989 C print *, "doing sscalefor top part"
8990 C print *,i,sslip,fracinbuf,ssgradlip
8992 eliptran=eliptran+pepliptran
8993 C print *,"I am in true lipid"
8996 C eliptran=elpitran+0.0 ! I am in water
8999 C print *, "nic nie bylo w lipidzie?"
9000 C now multiply all by the peptide group transfer factor
9001 C eliptran=eliptran*pepliptran
9002 C now the same for side chains
9005 if (itype(i).eq.ntyp1) cycle
9006 positi=(mod(c(3,i+nres),boxzsize))
9007 if (positi.le.0) positi=positi+boxzsize
9008 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9009 c for each residue check if it is in lipid or lipid water border area
9010 C respos=mod(c(3,i+nres),boxzsize)
9011 C print *,positi,bordlipbot,buflipbot
9012 if ((positi.gt.bordlipbot)
9013 & .and.(positi.lt.bordliptop)) then
9014 C the energy transfer exist
9015 if (positi.lt.buflipbot) then
9017 & ((positi-bordlipbot)/lipbufthick)
9018 C lipbufthick is thickenes of lipid buffore
9019 sslip=sscalelip(fracinbuf)
9020 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9021 eliptran=eliptran+sslip*liptranene(itype(i))
9022 gliptranx(3,i)=gliptranx(3,i)
9023 &+ssgradlip*liptranene(itype(i))
9024 gliptranc(3,i-1)= gliptranc(3,i-1)
9025 &+ssgradlip*liptranene(itype(i))
9026 C print *,"doing sccale for lower part"
9027 elseif (positi.gt.bufliptop) then
9029 &((bordliptop-positi)/lipbufthick)
9030 sslip=sscalelip(fracinbuf)
9031 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9032 eliptran=eliptran+sslip*liptranene(itype(i))
9033 gliptranx(3,i)=gliptranx(3,i)
9034 &+ssgradlip*liptranene(itype(i))
9035 gliptranc(3,i-1)= gliptranc(3,i-1)
9036 &+ssgradlip*liptranene(itype(i))
9037 C print *, "doing sscalefor top part",sslip,fracinbuf
9039 eliptran=eliptran+liptranene(itype(i))
9040 C print *,"I am in true lipid"
9042 endif ! if in lipid or buffor
9044 C eliptran=elpitran+0.0 ! I am in water
9050 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9052 SUBROUTINE MATVEC2(A1,V1,V2)
9053 implicit real*8 (a-h,o-z)
9054 include 'DIMENSIONS'
9055 DIMENSION A1(2,2),V1(2),V2(2)
9059 c 3 VI=VI+A1(I,K)*V1(K)
9063 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9064 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9069 C---------------------------------------
9070 SUBROUTINE MATMAT2(A1,A2,A3)
9071 implicit real*8 (a-h,o-z)
9072 include 'DIMENSIONS'
9073 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9074 c DIMENSION AI3(2,2)
9078 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9084 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9085 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9086 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9087 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9095 c-------------------------------------------------------------------------
9096 double precision function scalar2(u,v)
9098 double precision u(2),v(2)
9101 scalar2=u(1)*v(1)+u(2)*v(2)
9105 C-----------------------------------------------------------------------------
9107 subroutine transpose2(a,at)
9109 double precision a(2,2),at(2,2)
9116 c--------------------------------------------------------------------------
9117 subroutine transpose(n,a,at)
9120 double precision a(n,n),at(n,n)
9128 C---------------------------------------------------------------------------
9129 subroutine prodmat3(a1,a2,kk,transp,prod)
9132 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9134 crc double precision auxmat(2,2),prod_(2,2)
9137 crc call transpose2(kk(1,1),auxmat(1,1))
9138 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9139 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9141 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9142 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9143 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9144 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9145 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9146 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9147 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9148 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9151 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9152 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9154 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9155 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9156 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9157 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9158 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9159 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9160 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9161 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9164 c call transpose2(a2(1,1),a2t(1,1))
9167 crc print *,((prod_(i,j),i=1,2),j=1,2)
9168 crc print *,((prod(i,j),i=1,2),j=1,2)
9172 C-----------------------------------------------------------------------------
9173 double precision function scalar(u,v)
9175 double precision u(3),v(3)
9185 C-----------------------------------------------------------------------
9186 double precision function sscale(r)
9187 double precision r,gamm
9188 include "COMMON.SPLITELE"
9189 if(r.lt.r_cut-rlamb) then
9191 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9192 gamm=(r-(r_cut-rlamb))/rlamb
9193 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9199 C-----------------------------------------------------------------------
9200 C-----------------------------------------------------------------------
9201 double precision function sscagrad(r)
9202 double precision r,gamm
9203 include "COMMON.SPLITELE"
9204 if(r.lt.r_cut-rlamb) then
9206 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9207 gamm=(r-(r_cut-rlamb))/rlamb
9208 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9214 C-----------------------------------------------------------------------
9215 C-----------------------------------------------------------------------
9216 double precision function sscalelip(r)
9217 double precision r,gamm
9218 include "COMMON.SPLITELE"
9219 C if(r.lt.r_cut-rlamb) then
9221 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9222 C gamm=(r-(r_cut-rlamb))/rlamb
9223 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9229 C-----------------------------------------------------------------------
9230 double precision function sscagradlip(r)
9231 double precision r,gamm
9232 include "COMMON.SPLITELE"
9233 C if(r.lt.r_cut-rlamb) then
9235 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9236 C gamm=(r-(r_cut-rlamb))/rlamb
9237 sscagradlip=r*(6*r-6.0d0)
9244 C-----------------------------------------------------------------------
9245 subroutine set_shield_fac
9246 implicit real*8 (a-h,o-z)
9247 include 'DIMENSIONS'
9248 include 'DIMENSIONS.ZSCOPT'
9249 include 'COMMON.CHAIN'
9250 include 'COMMON.DERIV'
9251 include 'COMMON.IOUNITS'
9252 include 'COMMON.SHIELD'
9253 include 'COMMON.INTERACT'
9254 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9255 double precision div77_81/0.974996043d0/,
9256 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9258 C the vector between center of side_chain and peptide group
9259 double precision pep_side(3),long,side_calf(3),
9260 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9261 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9262 C the line belowe needs to be changed for FGPROC>1
9264 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9266 Cif there two consequtive dummy atoms there is no peptide group between them
9267 C the line below has to be changed for FGPROC>1
9270 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9274 C first lets set vector conecting the ithe side-chain with kth side-chain
9275 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9277 C and vector conecting the side-chain with its proper calfa
9278 side_calf(j)=c(j,k+nres)-c(j,k)
9279 C side_calf(j)=2.0d0
9280 pept_group(j)=c(j,i)-c(j,i+1)
9281 C lets have their lenght
9282 dist_pep_side=pep_side(j)**2+dist_pep_side
9283 dist_side_calf=dist_side_calf+side_calf(j)**2
9284 dist_pept_group=dist_pept_group+pept_group(j)**2
9286 dist_pep_side=dsqrt(dist_pep_side)
9287 dist_pept_group=dsqrt(dist_pept_group)
9288 dist_side_calf=dsqrt(dist_side_calf)
9290 pep_side_norm(j)=pep_side(j)/dist_pep_side
9291 side_calf_norm(j)=dist_side_calf
9293 C now sscale fraction
9294 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9295 C print *,buff_shield,"buff"
9297 if (sh_frac_dist.le.0.0) cycle
9298 C If we reach here it means that this side chain reaches the shielding sphere
9299 C Lets add him to the list for gradient
9300 ishield_list(i)=ishield_list(i)+1
9301 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9302 C this list is essential otherwise problem would be O3
9303 shield_list(ishield_list(i),i)=k
9304 C Lets have the sscale value
9305 if (sh_frac_dist.gt.1.0) then
9306 scale_fac_dist=1.0d0
9308 sh_frac_dist_grad(j)=0.0d0
9311 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9312 & *(2.0*sh_frac_dist-3.0d0)
9313 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9314 & /dist_pep_side/buff_shield*0.5
9315 C remember for the final gradient multiply sh_frac_dist_grad(j)
9316 C for side_chain by factor -2 !
9318 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9319 C print *,"jestem",scale_fac_dist,fac_help_scale,
9320 C & sh_frac_dist_grad(j)
9323 C if ((i.eq.3).and.(k.eq.2)) then
9324 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9328 C this is what is now we have the distance scaling now volume...
9329 short=short_r_sidechain(itype(k))
9330 long=long_r_sidechain(itype(k))
9331 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9334 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9337 costhet_grad(j)=costhet_fac*pep_side(j)
9339 C remember for the final gradient multiply costhet_grad(j)
9340 C for side_chain by factor -2 !
9341 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9342 C pep_side0pept_group is vector multiplication
9343 pep_side0pept_group=0.0
9345 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9347 cosalfa=(pep_side0pept_group/
9348 & (dist_pep_side*dist_side_calf))
9349 fac_alfa_sin=1.0-cosalfa**2
9350 fac_alfa_sin=dsqrt(fac_alfa_sin)
9351 rkprim=fac_alfa_sin*(long-short)+short
9353 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9354 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9357 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9358 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9359 &*(long-short)/fac_alfa_sin*cosalfa/
9360 &((dist_pep_side*dist_side_calf))*
9361 &((side_calf(j))-cosalfa*
9362 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9364 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9365 &*(long-short)/fac_alfa_sin*cosalfa
9366 &/((dist_pep_side*dist_side_calf))*
9368 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9371 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9374 C now the gradient...
9375 C grad_shield is gradient of Calfa for peptide groups
9376 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9378 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9379 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9381 grad_shield(j,i)=grad_shield(j,i)
9382 C gradient po skalowaniu
9383 & +(sh_frac_dist_grad(j)
9384 C gradient po costhet
9385 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9386 &-scale_fac_dist*(cosphi_grad_long(j))
9387 &/(1.0-cosphi) )*div77_81
9389 C grad_shield_side is Cbeta sidechain gradient
9390 grad_shield_side(j,ishield_list(i),i)=
9391 & (sh_frac_dist_grad(j)*(-2.0d0)
9392 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9393 & +scale_fac_dist*(cosphi_grad_long(j))
9394 & *2.0d0/(1.0-cosphi))
9395 & *div77_81*VofOverlap
9397 grad_shield_loc(j,ishield_list(i),i)=
9398 & scale_fac_dist*cosphi_grad_loc(j)
9399 & *2.0d0/(1.0-cosphi)
9400 & *div77_81*VofOverlap
9402 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9404 fac_shield(i)=VolumeTotal*div77_81+div4_81
9405 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9409 C--------------------------------------------------------------------------
9410 C first for shielding is setting of function of side-chains
9411 subroutine set_shield_fac2
9412 implicit real*8 (a-h,o-z)
9413 include 'DIMENSIONS'
9414 include 'DIMENSIONS.ZSCOPT'
9415 include 'COMMON.CHAIN'
9416 include 'COMMON.DERIV'
9417 include 'COMMON.IOUNITS'
9418 include 'COMMON.SHIELD'
9419 include 'COMMON.INTERACT'
9420 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9421 double precision div77_81/0.974996043d0/,
9422 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9424 C the vector between center of side_chain and peptide group
9425 double precision pep_side(3),long,side_calf(3),
9426 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9427 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9428 C the line belowe needs to be changed for FGPROC>1
9430 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9432 Cif there two consequtive dummy atoms there is no peptide group between them
9433 C the line below has to be changed for FGPROC>1
9436 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9440 C first lets set vector conecting the ithe side-chain with kth side-chain
9441 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9443 C and vector conecting the side-chain with its proper calfa
9444 side_calf(j)=c(j,k+nres)-c(j,k)
9445 C side_calf(j)=2.0d0
9446 pept_group(j)=c(j,i)-c(j,i+1)
9447 C lets have their lenght
9448 dist_pep_side=pep_side(j)**2+dist_pep_side
9449 dist_side_calf=dist_side_calf+side_calf(j)**2
9450 dist_pept_group=dist_pept_group+pept_group(j)**2
9452 dist_pep_side=dsqrt(dist_pep_side)
9453 dist_pept_group=dsqrt(dist_pept_group)
9454 dist_side_calf=dsqrt(dist_side_calf)
9456 pep_side_norm(j)=pep_side(j)/dist_pep_side
9457 side_calf_norm(j)=dist_side_calf
9459 C now sscale fraction
9460 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9461 C print *,buff_shield,"buff"
9463 if (sh_frac_dist.le.0.0) cycle
9464 C If we reach here it means that this side chain reaches the shielding sphere
9465 C Lets add him to the list for gradient
9466 ishield_list(i)=ishield_list(i)+1
9467 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9468 C this list is essential otherwise problem would be O3
9469 shield_list(ishield_list(i),i)=k
9470 C Lets have the sscale value
9471 if (sh_frac_dist.gt.1.0) then
9472 scale_fac_dist=1.0d0
9474 sh_frac_dist_grad(j)=0.0d0
9477 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9478 & *(2.0d0*sh_frac_dist-3.0d0)
9479 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9480 & /dist_pep_side/buff_shield*0.5d0
9481 C remember for the final gradient multiply sh_frac_dist_grad(j)
9482 C for side_chain by factor -2 !
9484 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9485 C sh_frac_dist_grad(j)=0.0d0
9486 C scale_fac_dist=1.0d0
9487 C print *,"jestem",scale_fac_dist,fac_help_scale,
9488 C & sh_frac_dist_grad(j)
9491 C this is what is now we have the distance scaling now volume...
9492 short=short_r_sidechain(itype(k))
9493 long=long_r_sidechain(itype(k))
9494 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9495 sinthet=short/dist_pep_side*costhet
9499 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9500 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9501 C & -short/dist_pep_side**2/costhet)
9504 costhet_grad(j)=costhet_fac*pep_side(j)
9506 C remember for the final gradient multiply costhet_grad(j)
9507 C for side_chain by factor -2 !
9508 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9509 C pep_side0pept_group is vector multiplication
9510 pep_side0pept_group=0.0d0
9512 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9514 cosalfa=(pep_side0pept_group/
9515 & (dist_pep_side*dist_side_calf))
9516 fac_alfa_sin=1.0d0-cosalfa**2
9517 fac_alfa_sin=dsqrt(fac_alfa_sin)
9518 rkprim=fac_alfa_sin*(long-short)+short
9522 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9524 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9525 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9529 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9530 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9531 &*(long-short)/fac_alfa_sin*cosalfa/
9532 &((dist_pep_side*dist_side_calf))*
9533 &((side_calf(j))-cosalfa*
9534 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9535 C cosphi_grad_long(j)=0.0d0
9536 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9537 &*(long-short)/fac_alfa_sin*cosalfa
9538 &/((dist_pep_side*dist_side_calf))*
9540 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9541 C cosphi_grad_loc(j)=0.0d0
9543 C print *,sinphi,sinthet
9544 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9547 C now the gradient...
9549 grad_shield(j,i)=grad_shield(j,i)
9550 C gradient po skalowaniu
9551 & +(sh_frac_dist_grad(j)*VofOverlap
9552 C gradient po costhet
9553 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9554 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9555 & sinphi/sinthet*costhet*costhet_grad(j)
9556 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9558 C grad_shield_side is Cbeta sidechain gradient
9559 grad_shield_side(j,ishield_list(i),i)=
9560 & (sh_frac_dist_grad(j)*(-2.0d0)
9562 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9563 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9564 & sinphi/sinthet*costhet*costhet_grad(j)
9565 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9568 grad_shield_loc(j,ishield_list(i),i)=
9569 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9570 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9571 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9575 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9577 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9578 c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i),
9579 c & " wshield",wshield
9580 c write(2,*) "TU",rpp(1,1),short,long,buff_shield
9584 C--------------------------------------------------------------------------
9585 double precision function tschebyshev(m,n,x,y)
9587 include "DIMENSIONS"
9589 double precision x(n),y,yy(0:maxvar),aux
9590 c Tschebyshev polynomial. Note that the first term is omitted
9591 c m=0: the constant term is included
9592 c m=1: the constant term is not included
9596 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9605 C--------------------------------------------------------------------------
9606 double precision function gradtschebyshev(m,n,x,y)
9608 include "DIMENSIONS"
9610 double precision x(n+1),y,yy(0:maxvar),aux
9611 c Tschebyshev polynomial. Note that the first term is omitted
9612 c m=0: the constant term is included
9613 c m=1: the constant term is not included
9617 yy(i)=2*y*yy(i-1)-yy(i-2)
9621 aux=aux+x(i+1)*yy(i)*(i+1)
9622 C print *, x(i+1),yy(i),i