1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 include 'COMMON.SHIELD'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
49 C write(iout,*) 'po elektostatyce'
51 C Calculate electrostatic (H-bonding) energy of the main chain.
54 if (shield_mode.eq.1) then
56 else if (shield_mode.eq.2) then
59 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
60 C write(iout,*) 'po eelec'
62 C Calculate excluded-volume interaction energy between peptide groups
65 call escp(evdw2,evdw2_14)
67 c Calculate the bond-stretching energy
71 C write (iout,*) "estr",estr
73 C Calculate the disulfide-bridge and other energy and the contributions
74 C from other distance constraints.
75 cd print *,'Calling EHPB'
77 cd print *,'EHPB exitted succesfully.'
79 C Calculate the virtual-bond-angle energy.
81 C print *,'Bend energy finished.'
82 call ebend(ebe,ethetacnstr)
83 cd print *,'Bend energy finished.'
85 C Calculate the SC local energy.
88 C print *,'SCLOC energy finished.'
90 C Calculate the virtual-bond torsional energy.
92 cd print *,'nterm=',nterm
93 call etor(etors,edihcnstr,fact(1))
95 C 6/23/01 Calculate double-torsional energy
97 call etor_d(etors_d,fact(2))
99 C 21/5/07 Calculate local sicdechain correlation energy
101 call eback_sc_corr(esccor)
103 if (wliptran.gt.0) then
104 call Eliptransfer(eliptran)
108 C 12/1/95 Multi-body terms
112 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
113 & .or. wturn6.gt.0.0d0) then
114 c print *,"calling multibody_eello"
115 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
116 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
117 c print *,ecorr,ecorr5,ecorr6,eturn6
124 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
125 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
127 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
129 if (shield_mode.gt.0) then
130 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
132 & +fact(1)*wvdwpp*evdw1
133 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
134 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
135 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
136 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
137 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
138 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
141 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
143 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
144 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
145 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
146 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
147 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
148 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
152 if (shield_mode.gt.0) then
153 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
154 & +welec*fact(1)*(ees+evdw1)
155 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
156 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
157 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
158 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
159 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
160 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
163 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
164 & +welec*fact(1)*(ees+evdw1)
165 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
166 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
167 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
168 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
169 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
170 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
177 energia(2)=evdw2-evdw2_14
194 energia(8)=eello_turn3
195 energia(9)=eello_turn4
204 energia(20)=edihcnstr
206 energia(24)=ethetacnstr
211 if (isnan(etot).ne.0) energia(0)=1.0d+99
213 if (isnan(etot)) energia(0)=1.0d+99
218 idumm=proc_proc(etot,i)
220 call proc_proc(etot,i)
222 if(i.eq.1)energia(0)=1.0d+99
229 call enerprint(energia,fact)
234 C Sum up the components of the Cartesian gradient.
239 if (shield_mode.eq.0) then
240 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
241 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
243 & wstrain*ghpbc(j,i)+
244 & wcorr*fact(3)*gradcorr(j,i)+
245 & wel_loc*fact(2)*gel_loc(j,i)+
246 & wturn3*fact(2)*gcorr3_turn(j,i)+
247 & wturn4*fact(3)*gcorr4_turn(j,i)+
248 & wcorr5*fact(4)*gradcorr5(j,i)+
249 & wcorr6*fact(5)*gradcorr6(j,i)+
250 & wturn6*fact(5)*gcorr6_turn(j,i)+
251 & wsccor*fact(2)*gsccorc(j,i)
252 & +wliptran*gliptranc(j,i)
253 & +welec*gshieldc(j,i)
254 & +welec*gshieldc_loc(j,i)
255 & +wcorr*gshieldc_ec(j,i)
256 & +wcorr*gshieldc_loc_ec(j,i)
257 & +wturn3*gshieldc_t3(j,i)
258 & +wturn3*gshieldc_loc_t3(j,i)
259 & +wturn4*gshieldc_t4(j,i)
260 & +wturn4*gshieldc_loc_t4(j,i)
261 & +wel_loc*gshieldc_ll(j,i)
262 & +wel_loc*gshieldc_loc_ll(j,i)
264 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
266 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
267 & wsccor*fact(2)*gsccorx(j,i)
268 & +wliptran*gliptranx(j,i)
269 & +welec*gshieldx(j,i)
270 & +wcorr*gshieldx_ec(j,i)
271 & +wturn3*gshieldx_t3(j,i)
272 & +wturn4*gshieldx_t4(j,i)
273 & +wel_loc*gshieldx_ll(j,i)
276 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
277 & +fact(1)*wscp*gvdwc_scp(j,i)+
278 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
280 & wstrain*ghpbc(j,i)+
281 & wcorr*fact(3)*gradcorr(j,i)+
282 & wel_loc*fact(2)*gel_loc(j,i)+
283 & wturn3*fact(2)*gcorr3_turn(j,i)+
284 & wturn4*fact(3)*gcorr4_turn(j,i)+
285 & wcorr5*fact(4)*gradcorr5(j,i)+
286 & wcorr6*fact(5)*gradcorr6(j,i)+
287 & wturn6*fact(5)*gcorr6_turn(j,i)+
288 & wsccor*fact(2)*gsccorc(j,i)
289 & +wliptran*gliptranc(j,i)
290 & +welec*gshieldc(j,i)
291 & +welec*gshieldc_loc(j,i)
292 & +wcorr*gshieldc_ec(j,i)
293 & +wcorr*gshieldc_loc_ec(j,i)
294 & +wturn3*gshieldc_t3(j,i)
295 & +wturn3*gshieldc_loc_t3(j,i)
296 & +wturn4*gshieldc_t4(j,i)
297 & +wturn4*gshieldc_loc_t4(j,i)
298 & +wel_loc*gshieldc_ll(j,i)
299 & +wel_loc*gshieldc_loc_ll(j,i)
301 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
302 & +fact(1)*wscp*gradx_scp(j,i)+
304 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
305 & wsccor*fact(2)*gsccorx(j,i)
306 & +wliptran*gliptranx(j,i)
307 & +welec*gshieldx(j,i)
308 & +wcorr*gshieldx_ec(j,i)
309 & +wturn3*gshieldx_t3(j,i)
310 & +wturn4*gshieldx_t4(j,i)
311 & +wel_loc*gshieldx_ll(j,i)
319 if (shield_mode.eq.0) then
320 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
321 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
323 & wcorr*fact(3)*gradcorr(j,i)+
324 & wel_loc*fact(2)*gel_loc(j,i)+
325 & wturn3*fact(2)*gcorr3_turn(j,i)+
326 & wturn4*fact(3)*gcorr4_turn(j,i)+
327 & wcorr5*fact(4)*gradcorr5(j,i)+
328 & wcorr6*fact(5)*gradcorr6(j,i)+
329 & wturn6*fact(5)*gcorr6_turn(j,i)+
330 & wsccor*fact(2)*gsccorc(j,i)
331 & +wliptran*gliptranc(j,i)
332 & +welec*gshieldc(j,i)
333 & +welec*gshieldc_loc(j,i)
334 & +wcorr*gshieldc_ec(j,i)
335 & +wcorr*gshieldc_loc_ec(j,i)
336 & +wturn3*gshieldc_t3(j,i)
337 & +wturn3*gshieldc_loc_t3(j,i)
338 & +wturn4*gshieldc_t4(j,i)
339 & +wturn4*gshieldc_loc_t4(j,i)
340 & +wel_loc*gshieldc_ll(j,i)
341 & +wel_loc*gshieldc_loc_ll(j,i)
343 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
345 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
346 & wsccor*fact(1)*gsccorx(j,i)
347 & +wliptran*gliptranx(j,i)
348 & +welec*gshieldx(j,i)
349 & +wcorr*gshieldx_ec(j,i)
350 & +wturn3*gshieldx_t3(j,i)
351 & +wturn4*gshieldx_t4(j,i)
352 & +wel_loc*gshieldx_ll(j,i)
355 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
356 & fact(1)*wscp*gvdwc_scp(j,i)+
357 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
359 & wcorr*fact(3)*gradcorr(j,i)+
360 & wel_loc*fact(2)*gel_loc(j,i)+
361 & wturn3*fact(2)*gcorr3_turn(j,i)+
362 & wturn4*fact(3)*gcorr4_turn(j,i)+
363 & wcorr5*fact(4)*gradcorr5(j,i)+
364 & wcorr6*fact(5)*gradcorr6(j,i)+
365 & wturn6*fact(5)*gcorr6_turn(j,i)+
366 & wsccor*fact(2)*gsccorc(j,i)
367 & +wliptran*gliptranc(j,i)
368 & +welec*gshieldc(j,i)
369 & +welec*gshieldc_loc(j,i)
370 & +wcorr*gshieldc_ec(j,i)
371 & +wcorr*gshieldc_loc_ec(j,i)
372 & +wturn3*gshieldc_t3(j,i)
373 & +wturn3*gshieldc_loc_t3(j,i)
374 & +wturn4*gshieldc_t4(j,i)
375 & +wturn4*gshieldc_loc_t4(j,i)
376 & +wel_loc*gshieldc_ll(j,i)
377 & +wel_loc*gshieldc_loc_ll(j,i)
379 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
380 & fact(1)*wscp*gradx_scp(j,i)+
382 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
383 & wsccor*fact(1)*gsccorx(j,i)
384 & +wliptran*gliptranx(j,i)
385 & +welec*gshieldx(j,i)
386 & +wcorr*gshieldx_ec(j,i)
387 & +wturn3*gshieldx_t3(j,i)
388 & +wturn4*gshieldx_t4(j,i)
389 & +wel_loc*gshieldx_ll(j,i)
398 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
399 & +wcorr5*fact(4)*g_corr5_loc(i)
400 & +wcorr6*fact(5)*g_corr6_loc(i)
401 & +wturn4*fact(3)*gel_loc_turn4(i)
402 & +wturn3*fact(2)*gel_loc_turn3(i)
403 & +wturn6*fact(5)*gel_loc_turn6(i)
404 & +wel_loc*fact(2)*gel_loc_loc(i)
405 c & +wsccor*fact(1)*gsccor_loc(i)
406 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
409 if (dyn_ss) call dyn_set_nss
412 C------------------------------------------------------------------------
413 subroutine enerprint(energia,fact)
414 implicit real*8 (a-h,o-z)
416 include 'DIMENSIONS.ZSCOPT'
417 include 'COMMON.IOUNITS'
418 include 'COMMON.FFIELD'
419 include 'COMMON.SBRIDGE'
420 double precision energia(0:max_ene),fact(6)
422 evdw=energia(1)+fact(6)*energia(21)
424 evdw2=energia(2)+energia(17)
436 eello_turn3=energia(8)
437 eello_turn4=energia(9)
438 eello_turn6=energia(10)
445 edihcnstr=energia(20)
447 ethetacnstr=energia(24)
450 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
452 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
453 & etors_d,wtor_d*fact(2),ehpb,wstrain,
454 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
455 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
456 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
457 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
458 & eliptran,wliptran,etot
459 10 format (/'Virtual-chain energies:'//
460 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
461 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
462 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
463 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
464 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
465 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
466 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
467 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
468 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
469 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
470 & ' (SS bridges & dist. cnstr.)'/
471 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
472 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
473 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
474 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
475 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
476 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
477 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
478 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
479 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
480 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
481 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
482 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
483 & 'ETOT= ',1pE16.6,' (total)')
485 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
486 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
487 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
488 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
489 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
490 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
491 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot
492 10 format (/'Virtual-chain energies:'//
493 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
494 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
495 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
496 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
497 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
498 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
499 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
500 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
501 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
502 & ' (SS bridges & dist. cnstr.)'/
503 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
504 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
505 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
506 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
507 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
508 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
509 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
510 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
511 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
512 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
513 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
514 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
515 & 'ETOT= ',1pE16.6,' (total)')
519 C-----------------------------------------------------------------------
520 subroutine elj(evdw,evdw_t)
522 C This subroutine calculates the interaction energy of nonbonded side chains
523 C assuming the LJ potential of interaction.
525 implicit real*8 (a-h,o-z)
527 include 'DIMENSIONS.ZSCOPT'
528 include "DIMENSIONS.COMPAR"
529 parameter (accur=1.0d-10)
532 include 'COMMON.LOCAL'
533 include 'COMMON.CHAIN'
534 include 'COMMON.DERIV'
535 include 'COMMON.INTERACT'
536 include 'COMMON.TORSION'
537 include 'COMMON.ENEPS'
538 include 'COMMON.SBRIDGE'
539 include 'COMMON.NAMES'
540 include 'COMMON.IOUNITS'
541 include 'COMMON.CONTACTS'
545 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
549 eneps_temp(j,i)=0.0d0
558 if (itypi.eq.ntyp1) cycle
559 itypi1=iabs(itype(i+1))
566 C Calculate SC interaction energy.
569 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
570 cd & 'iend=',iend(i,iint)
571 do j=istart(i,iint),iend(i,iint)
573 if (itypj.eq.ntyp1) cycle
577 C Change 12/1/95 to calculate four-body interactions
578 rij=xj*xj+yj*yj+zj*zj
580 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
581 eps0ij=eps(itypi,itypj)
586 ij=icant(itypi,itypj)
588 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
589 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
592 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
593 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
594 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
595 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
596 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
597 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
598 if (bb.gt.0.0d0) then
605 C Calculate the components of the gradient in DC and X
607 fac=-rrij*(e1+evdwij)
612 gvdwx(k,i)=gvdwx(k,i)-gg(k)
613 gvdwx(k,j)=gvdwx(k,j)+gg(k)
617 gvdwc(l,k)=gvdwc(l,k)+gg(l)
622 C 12/1/95, revised on 5/20/97
624 C Calculate the contact function. The ith column of the array JCONT will
625 C contain the numbers of atoms that make contacts with the atom I (of numbers
626 C greater than I). The arrays FACONT and GACONT will contain the values of
627 C the contact function and its derivative.
629 C Uncomment next line, if the correlation interactions include EVDW explicitly.
630 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
631 C Uncomment next line, if the correlation interactions are contact function only
632 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
634 sigij=sigma(itypi,itypj)
635 r0ij=rs0(itypi,itypj)
637 C Check whether the SC's are not too far to make a contact.
640 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
641 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
643 if (fcont.gt.0.0D0) then
644 C If the SC-SC distance if close to sigma, apply spline.
645 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
646 cAdam & fcont1,fprimcont1)
647 cAdam fcont1=1.0d0-fcont1
648 cAdam if (fcont1.gt.0.0d0) then
649 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
650 cAdam fcont=fcont*fcont1
652 C Uncomment following 4 lines to have the geometric average of the epsilon0's
653 cga eps0ij=1.0d0/dsqrt(eps0ij)
655 cga gg(k)=gg(k)*eps0ij
657 cga eps0ij=-evdwij*eps0ij
658 C Uncomment for AL's type of SC correlation interactions.
660 num_conti=num_conti+1
662 facont(num_conti,i)=fcont*eps0ij
663 fprimcont=eps0ij*fprimcont/rij
665 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
666 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
667 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
668 C Uncomment following 3 lines for Skolnick's type of SC correlation.
669 gacont(1,num_conti,i)=-fprimcont*xj
670 gacont(2,num_conti,i)=-fprimcont*yj
671 gacont(3,num_conti,i)=-fprimcont*zj
672 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
673 cd write (iout,'(2i3,3f10.5)')
674 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
680 num_cont(i)=num_conti
685 gvdwc(j,i)=expon*gvdwc(j,i)
686 gvdwx(j,i)=expon*gvdwx(j,i)
690 C******************************************************************************
694 C To save time, the factor of EXPON has been extracted from ALL components
695 C of GVDWC and GRADX. Remember to multiply them by this factor before further
698 C******************************************************************************
701 C-----------------------------------------------------------------------------
702 subroutine eljk(evdw,evdw_t)
704 C This subroutine calculates the interaction energy of nonbonded side chains
705 C assuming the LJK potential of interaction.
707 implicit real*8 (a-h,o-z)
709 include 'DIMENSIONS.ZSCOPT'
710 include "DIMENSIONS.COMPAR"
713 include 'COMMON.LOCAL'
714 include 'COMMON.CHAIN'
715 include 'COMMON.DERIV'
716 include 'COMMON.INTERACT'
717 include 'COMMON.ENEPS'
718 include 'COMMON.IOUNITS'
719 include 'COMMON.NAMES'
724 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
727 eneps_temp(j,i)=0.0d0
734 if (itypi.eq.ntyp1) cycle
735 itypi1=iabs(itype(i+1))
740 C Calculate SC interaction energy.
743 do j=istart(i,iint),iend(i,iint)
745 if (itypj.eq.ntyp1) cycle
749 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
751 e_augm=augm(itypi,itypj)*fac_augm
754 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
755 fac=r_shift_inv**expon
759 ij=icant(itypi,itypj)
760 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
761 & /dabs(eps(itypi,itypj))
762 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
763 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
764 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
765 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
766 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
767 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
768 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
769 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
770 if (bb.gt.0.0d0) then
777 C Calculate the components of the gradient in DC and X
779 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
784 gvdwx(k,i)=gvdwx(k,i)-gg(k)
785 gvdwx(k,j)=gvdwx(k,j)+gg(k)
789 gvdwc(l,k)=gvdwc(l,k)+gg(l)
799 gvdwc(j,i)=expon*gvdwc(j,i)
800 gvdwx(j,i)=expon*gvdwx(j,i)
806 C-----------------------------------------------------------------------------
807 subroutine ebp(evdw,evdw_t)
809 C This subroutine calculates the interaction energy of nonbonded side chains
810 C assuming the Berne-Pechukas potential of interaction.
812 implicit real*8 (a-h,o-z)
814 include 'DIMENSIONS.ZSCOPT'
815 include "DIMENSIONS.COMPAR"
818 include 'COMMON.LOCAL'
819 include 'COMMON.CHAIN'
820 include 'COMMON.DERIV'
821 include 'COMMON.NAMES'
822 include 'COMMON.INTERACT'
823 include 'COMMON.ENEPS'
824 include 'COMMON.IOUNITS'
825 include 'COMMON.CALC'
827 c double precision rrsave(maxdim)
833 eneps_temp(j,i)=0.0d0
838 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
839 c if (icall.eq.0) then
847 if (itypi.eq.ntyp1) cycle
848 itypi1=iabs(itype(i+1))
852 dxi=dc_norm(1,nres+i)
853 dyi=dc_norm(2,nres+i)
854 dzi=dc_norm(3,nres+i)
855 dsci_inv=vbld_inv(i+nres)
857 C Calculate SC interaction energy.
860 do j=istart(i,iint),iend(i,iint)
863 if (itypj.eq.ntyp1) cycle
864 dscj_inv=vbld_inv(j+nres)
865 chi1=chi(itypi,itypj)
866 chi2=chi(itypj,itypi)
873 alf12=0.5D0*(alf1+alf2)
874 C For diagnostics only!!!
887 dxj=dc_norm(1,nres+j)
888 dyj=dc_norm(2,nres+j)
889 dzj=dc_norm(3,nres+j)
890 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
891 cd if (icall.eq.0) then
897 C Calculate the angle-dependent terms of energy & contributions to derivatives.
899 C Calculate whole angle-dependent part of epsilon and contributions
901 fac=(rrij*sigsq)**expon2
904 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
905 eps2der=evdwij*eps3rt
906 eps3der=evdwij*eps2rt
907 evdwij=evdwij*eps2rt*eps3rt
908 ij=icant(itypi,itypj)
909 aux=eps1*eps2rt**2*eps3rt**2
910 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
911 & /dabs(eps(itypi,itypj))
912 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
913 if (bb.gt.0.0d0) then
920 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
922 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
923 & restyp(itypi),i,restyp(itypj),j,
924 & epsi,sigm,chi1,chi2,chip1,chip2,
925 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
926 & om1,om2,om12,1.0D0/dsqrt(rrij),
929 C Calculate gradient components.
930 e1=e1*eps1*eps2rt**2*eps3rt**2
931 fac=-expon*(e1+evdwij)
934 C Calculate radial part of the gradient
938 C Calculate the angular part of the gradient and sum add the contributions
939 C to the appropriate components of the Cartesian gradient.
948 C-----------------------------------------------------------------------------
949 subroutine egb(evdw,evdw_t)
951 C This subroutine calculates the interaction energy of nonbonded side chains
952 C assuming the Gay-Berne potential of interaction.
954 implicit real*8 (a-h,o-z)
956 include 'DIMENSIONS.ZSCOPT'
957 include "DIMENSIONS.COMPAR"
960 include 'COMMON.LOCAL'
961 include 'COMMON.CHAIN'
962 include 'COMMON.DERIV'
963 include 'COMMON.NAMES'
964 include 'COMMON.INTERACT'
965 include 'COMMON.ENEPS'
966 include 'COMMON.IOUNITS'
967 include 'COMMON.CALC'
968 include 'COMMON.SBRIDGE'
971 integer icant,xshift,yshift,zshift
975 eneps_temp(j,i)=0.0d0
978 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
982 c if (icall.gt.0) lprn=.true.
986 if (itypi.eq.ntyp1) cycle
987 itypi1=iabs(itype(i+1))
991 C returning the ith atom to box
993 if (xi.lt.0) xi=xi+boxxsize
995 if (yi.lt.0) yi=yi+boxysize
997 if (zi.lt.0) zi=zi+boxzsize
998 if ((zi.gt.bordlipbot)
999 &.and.(zi.lt.bordliptop)) then
1000 C the energy transfer exist
1001 if (zi.lt.buflipbot) then
1002 C what fraction I am in
1004 & ((zi-bordlipbot)/lipbufthick)
1005 C lipbufthick is thickenes of lipid buffore
1006 sslipi=sscalelip(fracinbuf)
1007 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1008 elseif (zi.gt.bufliptop) then
1009 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1010 sslipi=sscalelip(fracinbuf)
1011 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1021 dxi=dc_norm(1,nres+i)
1022 dyi=dc_norm(2,nres+i)
1023 dzi=dc_norm(3,nres+i)
1024 dsci_inv=vbld_inv(i+nres)
1026 C Calculate SC interaction energy.
1028 do iint=1,nint_gr(i)
1029 do j=istart(i,iint),iend(i,iint)
1030 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1031 call dyn_ssbond_ene(i,j,evdwij)
1033 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1034 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1035 C triple bond artifac removal
1036 do k=j+1,iend(i,iint)
1037 C search over all next residues
1038 if (dyn_ss_mask(k)) then
1039 C check if they are cysteins
1040 C write(iout,*) 'k=',k
1041 call triple_ssbond_ene(i,j,k,evdwij)
1042 C call the energy function that removes the artifical triple disulfide
1043 C bond the soubroutine is located in ssMD.F
1045 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1046 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1047 endif!dyn_ss_mask(k)
1051 itypj=iabs(itype(j))
1052 if (itypj.eq.ntyp1) cycle
1053 dscj_inv=vbld_inv(j+nres)
1054 sig0ij=sigma(itypi,itypj)
1055 chi1=chi(itypi,itypj)
1056 chi2=chi(itypj,itypi)
1063 alf12=0.5D0*(alf1+alf2)
1064 C For diagnostics only!!!
1077 C returning jth atom to box
1079 if (xj.lt.0) xj=xj+boxxsize
1081 if (yj.lt.0) yj=yj+boxysize
1083 if (zj.lt.0) zj=zj+boxzsize
1084 if ((zj.gt.bordlipbot)
1085 &.and.(zj.lt.bordliptop)) then
1086 C the energy transfer exist
1087 if (zj.lt.buflipbot) then
1088 C what fraction I am in
1090 & ((zj-bordlipbot)/lipbufthick)
1091 C lipbufthick is thickenes of lipid buffore
1092 sslipj=sscalelip(fracinbuf)
1093 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1094 elseif (zj.gt.bufliptop) then
1095 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1096 sslipj=sscalelip(fracinbuf)
1097 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1106 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1107 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1108 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1109 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1110 C if (aa.ne.aa_aq(itypi,itypj)) then
1112 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1113 C & bb_aq(itypi,itypj)-bb,
1117 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1118 C checking the distance
1119 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1124 C finding the closest
1128 xj=xj_safe+xshift*boxxsize
1129 yj=yj_safe+yshift*boxysize
1130 zj=zj_safe+zshift*boxzsize
1131 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1132 if(dist_temp.lt.dist_init) then
1142 if (subchap.eq.1) then
1152 dxj=dc_norm(1,nres+j)
1153 dyj=dc_norm(2,nres+j)
1154 dzj=dc_norm(3,nres+j)
1155 c write (iout,*) i,j,xj,yj,zj
1156 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1158 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1159 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1160 if (sss.le.0.0) cycle
1161 C Calculate angle-dependent terms of energy and contributions to their
1166 sig=sig0ij*dsqrt(sigsq)
1167 rij_shift=1.0D0/rij-sig+sig0ij
1168 C I hate to put IF's in the loops, but here don't have another choice!!!!
1169 if (rij_shift.le.0.0D0) then
1174 c---------------------------------------------------------------
1175 rij_shift=1.0D0/rij_shift
1176 fac=rij_shift**expon
1179 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1180 eps2der=evdwij*eps3rt
1181 eps3der=evdwij*eps2rt
1182 evdwij=evdwij*eps2rt*eps3rt
1184 evdw=evdw+evdwij*sss
1186 evdw_t=evdw_t+evdwij*sss
1188 ij=icant(itypi,itypj)
1189 aux=eps1*eps2rt**2*eps3rt**2
1190 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1191 & /dabs(eps(itypi,itypj))
1192 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1193 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1194 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1195 c & aux*e2/eps(itypi,itypj)
1197 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1201 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1202 & restyp(itypi),i,restyp(itypj),j,
1203 & epsi,sigm,chi1,chi2,chip1,chip2,
1204 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1205 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1207 write (iout,*) "partial sum", evdw, evdw_t
1212 C Calculate gradient components.
1213 e1=e1*eps1*eps2rt**2*eps3rt**2
1214 fac=-expon*(e1+evdwij)*rij_shift
1217 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1218 C Calculate the radial part of the gradient
1222 C Calculate angular part of the gradient.
1225 C write(iout,*) "partial sum", evdw, evdw_t
1232 C-----------------------------------------------------------------------------
1233 subroutine egbv(evdw,evdw_t)
1235 C This subroutine calculates the interaction energy of nonbonded side chains
1236 C assuming the Gay-Berne-Vorobjev potential of interaction.
1238 implicit real*8 (a-h,o-z)
1239 include 'DIMENSIONS'
1240 include 'DIMENSIONS.ZSCOPT'
1241 include "DIMENSIONS.COMPAR"
1242 include 'COMMON.GEO'
1243 include 'COMMON.VAR'
1244 include 'COMMON.LOCAL'
1245 include 'COMMON.CHAIN'
1246 include 'COMMON.DERIV'
1247 include 'COMMON.NAMES'
1248 include 'COMMON.INTERACT'
1249 include 'COMMON.ENEPS'
1250 include 'COMMON.IOUNITS'
1251 include 'COMMON.CALC'
1252 common /srutu/ icall
1258 eneps_temp(j,i)=0.0d0
1263 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1266 c if (icall.gt.0) lprn=.true.
1268 do i=iatsc_s,iatsc_e
1269 itypi=iabs(itype(i))
1270 if (itypi.eq.ntyp1) cycle
1271 itypi1=iabs(itype(i+1))
1275 dxi=dc_norm(1,nres+i)
1276 dyi=dc_norm(2,nres+i)
1277 dzi=dc_norm(3,nres+i)
1278 dsci_inv=vbld_inv(i+nres)
1280 C Calculate SC interaction energy.
1282 do iint=1,nint_gr(i)
1283 do j=istart(i,iint),iend(i,iint)
1285 itypj=iabs(itype(j))
1286 if (itypj.eq.ntyp1) cycle
1287 dscj_inv=vbld_inv(j+nres)
1288 sig0ij=sigma(itypi,itypj)
1289 r0ij=r0(itypi,itypj)
1290 chi1=chi(itypi,itypj)
1291 chi2=chi(itypj,itypi)
1298 alf12=0.5D0*(alf1+alf2)
1299 C For diagnostics only!!!
1312 dxj=dc_norm(1,nres+j)
1313 dyj=dc_norm(2,nres+j)
1314 dzj=dc_norm(3,nres+j)
1315 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1317 C Calculate angle-dependent terms of energy and contributions to their
1321 sig=sig0ij*dsqrt(sigsq)
1322 rij_shift=1.0D0/rij-sig+r0ij
1323 C I hate to put IF's in the loops, but here don't have another choice!!!!
1324 if (rij_shift.le.0.0D0) then
1329 c---------------------------------------------------------------
1330 rij_shift=1.0D0/rij_shift
1331 fac=rij_shift**expon
1334 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1335 eps2der=evdwij*eps3rt
1336 eps3der=evdwij*eps2rt
1337 fac_augm=rrij**expon
1338 e_augm=augm(itypi,itypj)*fac_augm
1339 evdwij=evdwij*eps2rt*eps3rt
1340 if (bb.gt.0.0d0) then
1341 evdw=evdw+evdwij+e_augm
1343 evdw_t=evdw_t+evdwij+e_augm
1345 ij=icant(itypi,itypj)
1346 aux=eps1*eps2rt**2*eps3rt**2
1347 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1348 & /dabs(eps(itypi,itypj))
1349 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1350 c eneps_temp(ij)=eneps_temp(ij)
1351 c & +(evdwij+e_augm)/eps(itypi,itypj)
1353 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1354 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1355 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1356 c & restyp(itypi),i,restyp(itypj),j,
1357 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1358 c & chi1,chi2,chip1,chip2,
1359 c & eps1,eps2rt**2,eps3rt**2,
1360 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1364 C Calculate gradient components.
1365 e1=e1*eps1*eps2rt**2*eps3rt**2
1366 fac=-expon*(e1+evdwij)*rij_shift
1368 fac=rij*fac-2*expon*rrij*e_augm
1369 C Calculate the radial part of the gradient
1373 C Calculate angular part of the gradient.
1381 C-----------------------------------------------------------------------------
1382 subroutine sc_angular
1383 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1384 C om12. Called by ebp, egb, and egbv.
1386 include 'COMMON.CALC'
1390 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1391 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1392 om12=dxi*dxj+dyi*dyj+dzi*dzj
1394 C Calculate eps1(om12) and its derivative in om12
1395 faceps1=1.0D0-om12*chiom12
1396 faceps1_inv=1.0D0/faceps1
1397 eps1=dsqrt(faceps1_inv)
1398 C Following variable is eps1*deps1/dom12
1399 eps1_om12=faceps1_inv*chiom12
1400 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1405 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1406 sigsq=1.0D0-facsig*faceps1_inv
1407 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1408 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1409 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1410 C Calculate eps2 and its derivatives in om1, om2, and om12.
1413 chipom12=chip12*om12
1414 facp=1.0D0-om12*chipom12
1416 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1417 C Following variable is the square root of eps2
1418 eps2rt=1.0D0-facp1*facp_inv
1419 C Following three variables are the derivatives of the square root of eps
1420 C in om1, om2, and om12.
1421 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1422 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1423 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1424 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1425 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1426 C Calculate whole angle-dependent part of epsilon and contributions
1427 C to its derivatives
1430 C----------------------------------------------------------------------------
1432 implicit real*8 (a-h,o-z)
1433 include 'DIMENSIONS'
1434 include 'DIMENSIONS.ZSCOPT'
1435 include 'COMMON.CHAIN'
1436 include 'COMMON.DERIV'
1437 include 'COMMON.CALC'
1438 double precision dcosom1(3),dcosom2(3)
1439 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1440 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1441 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1442 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1444 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1445 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1448 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1451 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1452 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1453 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1454 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1455 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1456 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1459 C Calculate the components of the gradient in DC and X
1463 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1468 c------------------------------------------------------------------------------
1469 subroutine vec_and_deriv
1470 implicit real*8 (a-h,o-z)
1471 include 'DIMENSIONS'
1472 include 'DIMENSIONS.ZSCOPT'
1473 include 'COMMON.IOUNITS'
1474 include 'COMMON.GEO'
1475 include 'COMMON.VAR'
1476 include 'COMMON.LOCAL'
1477 include 'COMMON.CHAIN'
1478 include 'COMMON.VECTORS'
1479 include 'COMMON.DERIV'
1480 include 'COMMON.INTERACT'
1481 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1482 C Compute the local reference systems. For reference system (i), the
1483 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1484 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1486 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1487 if (i.eq.nres-1) then
1488 C Case of the last full residue
1489 C Compute the Z-axis
1490 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1491 costh=dcos(pi-theta(nres))
1492 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1497 C Compute the derivatives of uz
1499 uzder(2,1,1)=-dc_norm(3,i-1)
1500 uzder(3,1,1)= dc_norm(2,i-1)
1501 uzder(1,2,1)= dc_norm(3,i-1)
1503 uzder(3,2,1)=-dc_norm(1,i-1)
1504 uzder(1,3,1)=-dc_norm(2,i-1)
1505 uzder(2,3,1)= dc_norm(1,i-1)
1508 uzder(2,1,2)= dc_norm(3,i)
1509 uzder(3,1,2)=-dc_norm(2,i)
1510 uzder(1,2,2)=-dc_norm(3,i)
1512 uzder(3,2,2)= dc_norm(1,i)
1513 uzder(1,3,2)= dc_norm(2,i)
1514 uzder(2,3,2)=-dc_norm(1,i)
1517 C Compute the Y-axis
1520 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1523 C Compute the derivatives of uy
1526 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1527 & -dc_norm(k,i)*dc_norm(j,i-1)
1528 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1530 uyder(j,j,1)=uyder(j,j,1)-costh
1531 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1536 uygrad(l,k,j,i)=uyder(l,k,j)
1537 uzgrad(l,k,j,i)=uzder(l,k,j)
1541 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1542 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1543 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1544 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1548 C Compute the Z-axis
1549 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1550 costh=dcos(pi-theta(i+2))
1551 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1556 C Compute the derivatives of uz
1558 uzder(2,1,1)=-dc_norm(3,i+1)
1559 uzder(3,1,1)= dc_norm(2,i+1)
1560 uzder(1,2,1)= dc_norm(3,i+1)
1562 uzder(3,2,1)=-dc_norm(1,i+1)
1563 uzder(1,3,1)=-dc_norm(2,i+1)
1564 uzder(2,3,1)= dc_norm(1,i+1)
1567 uzder(2,1,2)= dc_norm(3,i)
1568 uzder(3,1,2)=-dc_norm(2,i)
1569 uzder(1,2,2)=-dc_norm(3,i)
1571 uzder(3,2,2)= dc_norm(1,i)
1572 uzder(1,3,2)= dc_norm(2,i)
1573 uzder(2,3,2)=-dc_norm(1,i)
1576 C Compute the Y-axis
1579 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1582 C Compute the derivatives of uy
1585 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1586 & -dc_norm(k,i)*dc_norm(j,i+1)
1587 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1589 uyder(j,j,1)=uyder(j,j,1)-costh
1590 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1595 uygrad(l,k,j,i)=uyder(l,k,j)
1596 uzgrad(l,k,j,i)=uzder(l,k,j)
1600 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1601 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1602 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1603 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1609 vbld_inv_temp(1)=vbld_inv(i+1)
1610 if (i.lt.nres-1) then
1611 vbld_inv_temp(2)=vbld_inv(i+2)
1613 vbld_inv_temp(2)=vbld_inv(i)
1618 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1619 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1627 C-----------------------------------------------------------------------------
1628 subroutine vec_and_deriv_test
1629 implicit real*8 (a-h,o-z)
1630 include 'DIMENSIONS'
1631 include 'DIMENSIONS.ZSCOPT'
1632 include 'COMMON.IOUNITS'
1633 include 'COMMON.GEO'
1634 include 'COMMON.VAR'
1635 include 'COMMON.LOCAL'
1636 include 'COMMON.CHAIN'
1637 include 'COMMON.VECTORS'
1638 dimension uyder(3,3,2),uzder(3,3,2)
1639 C Compute the local reference systems. For reference system (i), the
1640 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1641 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1643 if (i.eq.nres-1) then
1644 C Case of the last full residue
1645 C Compute the Z-axis
1646 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1647 costh=dcos(pi-theta(nres))
1648 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1649 c write (iout,*) 'fac',fac,
1650 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1651 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1655 C Compute the derivatives of uz
1657 uzder(2,1,1)=-dc_norm(3,i-1)
1658 uzder(3,1,1)= dc_norm(2,i-1)
1659 uzder(1,2,1)= dc_norm(3,i-1)
1661 uzder(3,2,1)=-dc_norm(1,i-1)
1662 uzder(1,3,1)=-dc_norm(2,i-1)
1663 uzder(2,3,1)= dc_norm(1,i-1)
1666 uzder(2,1,2)= dc_norm(3,i)
1667 uzder(3,1,2)=-dc_norm(2,i)
1668 uzder(1,2,2)=-dc_norm(3,i)
1670 uzder(3,2,2)= dc_norm(1,i)
1671 uzder(1,3,2)= dc_norm(2,i)
1672 uzder(2,3,2)=-dc_norm(1,i)
1674 C Compute the Y-axis
1676 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1679 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1680 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1681 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1683 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1686 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1687 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1690 c write (iout,*) 'facy',facy,
1691 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1692 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1694 uy(k,i)=facy*uy(k,i)
1696 C Compute the derivatives of uy
1699 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1700 & -dc_norm(k,i)*dc_norm(j,i-1)
1701 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1703 c uyder(j,j,1)=uyder(j,j,1)-costh
1704 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1705 uyder(j,j,1)=uyder(j,j,1)
1706 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1707 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1713 uygrad(l,k,j,i)=uyder(l,k,j)
1714 uzgrad(l,k,j,i)=uzder(l,k,j)
1718 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1719 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1720 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1721 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1724 C Compute the Z-axis
1725 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1726 costh=dcos(pi-theta(i+2))
1727 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1728 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1732 C Compute the derivatives of uz
1734 uzder(2,1,1)=-dc_norm(3,i+1)
1735 uzder(3,1,1)= dc_norm(2,i+1)
1736 uzder(1,2,1)= dc_norm(3,i+1)
1738 uzder(3,2,1)=-dc_norm(1,i+1)
1739 uzder(1,3,1)=-dc_norm(2,i+1)
1740 uzder(2,3,1)= dc_norm(1,i+1)
1743 uzder(2,1,2)= dc_norm(3,i)
1744 uzder(3,1,2)=-dc_norm(2,i)
1745 uzder(1,2,2)=-dc_norm(3,i)
1747 uzder(3,2,2)= dc_norm(1,i)
1748 uzder(1,3,2)= dc_norm(2,i)
1749 uzder(2,3,2)=-dc_norm(1,i)
1751 C Compute the Y-axis
1753 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1754 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1755 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1757 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1760 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1761 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1764 c write (iout,*) 'facy',facy,
1765 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1766 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1768 uy(k,i)=facy*uy(k,i)
1770 C Compute the derivatives of uy
1773 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1774 & -dc_norm(k,i)*dc_norm(j,i+1)
1775 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1777 c uyder(j,j,1)=uyder(j,j,1)-costh
1778 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1779 uyder(j,j,1)=uyder(j,j,1)
1780 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1781 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1787 uygrad(l,k,j,i)=uyder(l,k,j)
1788 uzgrad(l,k,j,i)=uzder(l,k,j)
1792 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1793 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1794 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1795 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1802 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1803 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1810 C-----------------------------------------------------------------------------
1811 subroutine check_vecgrad
1812 implicit real*8 (a-h,o-z)
1813 include 'DIMENSIONS'
1814 include 'DIMENSIONS.ZSCOPT'
1815 include 'COMMON.IOUNITS'
1816 include 'COMMON.GEO'
1817 include 'COMMON.VAR'
1818 include 'COMMON.LOCAL'
1819 include 'COMMON.CHAIN'
1820 include 'COMMON.VECTORS'
1821 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1822 dimension uyt(3,maxres),uzt(3,maxres)
1823 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1824 double precision delta /1.0d-7/
1827 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1828 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1829 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1830 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1831 cd & (dc_norm(if90,i),if90=1,3)
1832 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1833 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1834 cd write(iout,'(a)')
1840 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1841 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1854 cd write (iout,*) 'i=',i
1856 erij(k)=dc_norm(k,i)
1860 dc_norm(k,i)=erij(k)
1862 dc_norm(j,i)=dc_norm(j,i)+delta
1863 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1865 c dc_norm(k,i)=dc_norm(k,i)/fac
1867 c write (iout,*) (dc_norm(k,i),k=1,3)
1868 c write (iout,*) (erij(k),k=1,3)
1871 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1872 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1873 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1874 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1876 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1877 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1878 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1881 dc_norm(k,i)=erij(k)
1884 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1885 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1886 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1887 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1888 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1889 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1890 cd write (iout,'(a)')
1895 C--------------------------------------------------------------------------
1896 subroutine set_matrices
1897 implicit real*8 (a-h,o-z)
1898 include 'DIMENSIONS'
1899 include 'DIMENSIONS.ZSCOPT'
1900 include 'COMMON.IOUNITS'
1901 include 'COMMON.GEO'
1902 include 'COMMON.VAR'
1903 include 'COMMON.LOCAL'
1904 include 'COMMON.CHAIN'
1905 include 'COMMON.DERIV'
1906 include 'COMMON.INTERACT'
1907 include 'COMMON.CONTACTS'
1908 include 'COMMON.TORSION'
1909 include 'COMMON.VECTORS'
1910 include 'COMMON.FFIELD'
1911 double precision auxvec(2),auxmat(2,2)
1913 C Compute the virtual-bond-torsional-angle dependent quantities needed
1914 C to calculate the el-loc multibody terms of various order.
1917 if (i .lt. nres+1) then
1954 if (i .gt. 3 .and. i .lt. nres+1) then
1955 obrot_der(1,i-2)=-sin1
1956 obrot_der(2,i-2)= cos1
1957 Ugder(1,1,i-2)= sin1
1958 Ugder(1,2,i-2)=-cos1
1959 Ugder(2,1,i-2)=-cos1
1960 Ugder(2,2,i-2)=-sin1
1963 obrot2_der(1,i-2)=-dwasin2
1964 obrot2_der(2,i-2)= dwacos2
1965 Ug2der(1,1,i-2)= dwasin2
1966 Ug2der(1,2,i-2)=-dwacos2
1967 Ug2der(2,1,i-2)=-dwacos2
1968 Ug2der(2,2,i-2)=-dwasin2
1970 obrot_der(1,i-2)=0.0d0
1971 obrot_der(2,i-2)=0.0d0
1972 Ugder(1,1,i-2)=0.0d0
1973 Ugder(1,2,i-2)=0.0d0
1974 Ugder(2,1,i-2)=0.0d0
1975 Ugder(2,2,i-2)=0.0d0
1976 obrot2_der(1,i-2)=0.0d0
1977 obrot2_der(2,i-2)=0.0d0
1978 Ug2der(1,1,i-2)=0.0d0
1979 Ug2der(1,2,i-2)=0.0d0
1980 Ug2der(2,1,i-2)=0.0d0
1981 Ug2der(2,2,i-2)=0.0d0
1983 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1984 if (itype(i-2).le.ntyp) then
1985 iti = itortyp(itype(i-2))
1992 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1993 if (itype(i-1).le.ntyp) then
1994 iti1 = itortyp(itype(i-1))
2001 cd write (iout,*) '*******i',i,' iti1',iti
2002 cd write (iout,*) 'b1',b1(:,iti)
2003 cd write (iout,*) 'b2',b2(:,iti)
2004 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2005 c print *,"itilde1 i iti iti1",i,iti,iti1
2006 if (i .gt. iatel_s+2) then
2007 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2008 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2009 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2010 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2011 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2012 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2013 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2023 DtUg2(l,k,i-2)=0.0d0
2027 c print *,"itilde2 i iti iti1",i,iti,iti1
2028 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2029 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2030 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2031 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2032 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2033 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2034 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2035 c print *,"itilde3 i iti iti1",i,iti,iti1
2037 muder(k,i-2)=Ub2der(k,i-2)
2039 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2040 if (itype(i-1).le.ntyp) then
2041 iti1 = itortyp(itype(i-1))
2049 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2051 C write (iout,*) 'mumu',i,b1(1,iti),Ub2(1,i-2)
2053 C Vectors and matrices dependent on a single virtual-bond dihedral.
2054 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2055 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2056 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2057 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2058 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2059 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2060 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2061 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2062 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2063 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
2064 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
2066 C Matrices dependent on two consecutive virtual-bond dihedrals.
2067 C The order of matrices is from left to right.
2069 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2070 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2071 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2072 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2073 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2074 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2075 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2076 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2079 cd iti = itortyp(itype(i))
2082 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2083 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2088 C--------------------------------------------------------------------------
2089 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2091 C This subroutine calculates the average interaction energy and its gradient
2092 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2093 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2094 C The potential depends both on the distance of peptide-group centers and on
2095 C the orientation of the CA-CA virtual bonds.
2097 implicit real*8 (a-h,o-z)
2098 include 'DIMENSIONS'
2099 include 'DIMENSIONS.ZSCOPT'
2100 include 'COMMON.CONTROL'
2101 include 'COMMON.IOUNITS'
2102 include 'COMMON.GEO'
2103 include 'COMMON.VAR'
2104 include 'COMMON.LOCAL'
2105 include 'COMMON.CHAIN'
2106 include 'COMMON.DERIV'
2107 include 'COMMON.INTERACT'
2108 include 'COMMON.CONTACTS'
2109 include 'COMMON.TORSION'
2110 include 'COMMON.VECTORS'
2111 include 'COMMON.FFIELD'
2112 include 'COMMON.SHIELD'
2113 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2114 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2115 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2116 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2117 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2118 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2119 double precision scal_el /0.5d0/
2121 C 13-go grudnia roku pamietnego...
2122 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2123 & 0.0d0,1.0d0,0.0d0,
2124 & 0.0d0,0.0d0,1.0d0/
2125 cd write(iout,*) 'In EELEC'
2127 cd write(iout,*) 'Type',i
2128 cd write(iout,*) 'B1',B1(:,i)
2129 cd write(iout,*) 'B2',B2(:,i)
2130 cd write(iout,*) 'CC',CC(:,:,i)
2131 cd write(iout,*) 'DD',DD(:,:,i)
2132 cd write(iout,*) 'EE',EE(:,:,i)
2134 cd call check_vecgrad
2136 if (icheckgrad.eq.1) then
2138 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2140 dc_norm(k,i)=dc(k,i)*fac
2142 c write (iout,*) 'i',i,' fac',fac
2145 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2146 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2147 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2148 cd if (wel_loc.gt.0.0d0) then
2149 if (icheckgrad.eq.1) then
2150 call vec_and_deriv_test
2157 cd write (iout,*) 'i=',i
2159 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2162 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2163 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2176 C print '(a)','Enter EELEC'
2177 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2179 gel_loc_loc(i)=0.0d0
2182 do i=iatel_s,iatel_e
2184 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2185 C & .or. itype(i+2).eq.ntyp1) cycle
2187 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2188 C & .or. itype(i+2).eq.ntyp1
2189 C & .or. itype(i-1).eq.ntyp1
2192 if (itel(i).eq.0) goto 1215
2196 dx_normi=dc_norm(1,i)
2197 dy_normi=dc_norm(2,i)
2198 dz_normi=dc_norm(3,i)
2199 xmedi=c(1,i)+0.5d0*dxi
2200 ymedi=c(2,i)+0.5d0*dyi
2201 zmedi=c(3,i)+0.5d0*dzi
2202 xmedi=mod(xmedi,boxxsize)
2203 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2204 ymedi=mod(ymedi,boxysize)
2205 if (ymedi.lt.0) ymedi=ymedi+boxysize
2206 zmedi=mod(zmedi,boxzsize)
2207 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2208 zmedi2=mod(zmedi,boxzsize)
2209 if (zmedi2.lt.0) zmedi2=zmedi2+boxzsize
2210 if ((zmedi2.gt.bordlipbot)
2211 &.and.(zmedi2.lt.bordliptop)) then
2212 C the energy transfer exist
2213 if (zmedi2.lt.buflipbot) then
2214 C what fraction I am in
2216 & ((zmedi2-bordlipbot)/lipbufthick)
2217 C lipbufthick is thickenes of lipid buffore
2218 sslipi=sscalelip(fracinbuf)
2219 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2220 elseif (zmedi2.gt.bufliptop) then
2221 fracinbuf=1.0d0-((bordliptop-zmedi2)/lipbufthick)
2222 sslipi=sscalelip(fracinbuf)
2223 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2234 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2235 do j=ielstart(i),ielend(i)
2237 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2238 C & .or.itype(j+2).eq.ntyp1
2241 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2242 C & .or.itype(j+2).eq.ntyp1
2243 C & .or.itype(j-1).eq.ntyp1
2248 if (itel(j).eq.0) goto 1216
2252 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2253 aaa=app(iteli,itelj)
2254 bbb=bpp(iteli,itelj)
2255 C Diagnostics only!!!
2261 ael6i=ael6(iteli,itelj)
2262 ael3i=ael3(iteli,itelj)
2266 dx_normj=dc_norm(1,j)
2267 dy_normj=dc_norm(2,j)
2268 dz_normj=dc_norm(3,j)
2273 if (xj.lt.0) xj=xj+boxxsize
2275 if (yj.lt.0) yj=yj+boxysize
2277 if (zj.lt.0) zj=zj+boxzsize
2278 if ((zj.gt.bordlipbot)
2279 &.and.(zj.lt.bordliptop)) then
2280 C the energy transfer exist
2281 if (zj.lt.buflipbot) then
2282 C what fraction I am in
2284 & ((zj-bordlipbot)/lipbufthick)
2285 C lipbufthick is thickenes of lipid buffore
2286 sslipj=sscalelip(fracinbuf)
2287 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2288 elseif (zj.gt.bufliptop) then
2289 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2290 sslipj=sscalelip(fracinbuf)
2291 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2300 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2308 xj=xj_safe+xshift*boxxsize
2309 yj=yj_safe+yshift*boxysize
2310 zj=zj_safe+zshift*boxzsize
2311 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2312 if(dist_temp.lt.dist_init) then
2322 if (isubchap.eq.1) then
2331 rij=xj*xj+yj*yj+zj*zj
2332 sss=sscale(sqrt(rij))
2333 sssgrad=sscagrad(sqrt(rij))
2339 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2340 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2341 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2342 fac=cosa-3.0D0*cosb*cosg
2344 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2345 if (j.eq.i+2) ev1=scal_el*ev1
2350 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2353 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2354 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2355 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2356 if (shield_mode.gt.0) then
2359 write(iout,*) "ees_compon",i,j,el1,el2,
2360 & fac_shield(i),fac_shield(j)
2365 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2366 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2375 evdw1=evdw1+evdwij*sss
2376 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2377 c &'evdw1',i,j,evdwij
2378 c &,iteli,itelj,aaa,evdw1
2380 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2381 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2382 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2383 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2384 c & xmedi,ymedi,zmedi,xj,yj,zj
2386 C Calculate contributions to the Cartesian gradient.
2389 facvdw=-6*rrmij*(ev1+evdwij)*sss
2390 facel=-3*rrmij*(el1+eesij)
2397 * Radial derivatives. First process both termini of the fragment (i,j)
2402 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2403 & (shield_mode.gt.0)) then
2405 do ilist=1,ishield_list(i)
2406 iresshield=shield_list(ilist,i)
2408 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2410 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2412 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2413 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2414 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2415 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2416 C if (iresshield.gt.i) then
2417 C do ishi=i+1,iresshield-1
2418 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2419 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2423 C do ishi=iresshield,i
2424 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2425 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2431 do ilist=1,ishield_list(j)
2432 iresshield=shield_list(ilist,j)
2434 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2436 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2438 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2439 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2444 gshieldc(k,i)=gshieldc(k,i)+
2445 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2446 gshieldc(k,j)=gshieldc(k,j)+
2447 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2448 gshieldc(k,i-1)=gshieldc(k,i-1)+
2449 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2450 gshieldc(k,j-1)=gshieldc(k,j-1)+
2451 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2458 gelc(k,i)=gelc(k,i)+ghalf
2459 gelc(k,j)=gelc(k,j)+ghalf
2462 * Loop over residues i+1 thru j-1.
2466 gelc(l,k)=gelc(l,k)+ggg(l)
2472 if (sss.gt.0.0) then
2473 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2474 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2475 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2483 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2484 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2487 * Loop over residues i+1 thru j-1.
2491 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2495 facvdw=(ev1+evdwij)*sss
2498 fac=-3*rrmij*(facvdw+facvdw+facel)
2504 * Radial derivatives. First process both termini of the fragment (i,j)
2511 gelc(k,i)=gelc(k,i)+ghalf
2512 gelc(k,j)=gelc(k,j)+ghalf
2515 * Loop over residues i+1 thru j-1.
2519 gelc(l,k)=gelc(l,k)+ggg(l)
2526 ecosa=2.0D0*fac3*fac1+fac4
2529 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2530 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2532 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2533 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2535 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2536 cd & (dcosg(k),k=1,3)
2538 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2539 & *fac_shield(i)**2*fac_shield(j)**2
2543 gelc(k,i)=gelc(k,i)+ghalf
2544 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2545 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2546 & *fac_shield(i)**2*fac_shield(j)**2
2548 gelc(k,j)=gelc(k,j)+ghalf
2549 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2550 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2551 & *fac_shield(i)**2*fac_shield(j)**2
2555 gelc(l,k)=gelc(l,k)+ggg(l)
2560 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2561 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2562 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2564 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2565 C energy of a peptide unit is assumed in the form of a second-order
2566 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2567 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2568 C are computed for EVERY pair of non-contiguous peptide groups.
2570 if (j.lt.nres-1) then
2581 muij(kkk)=mu(k,i)*mu(l,j)
2584 cd write (iout,*) 'EELEC: i',i,' j',j
2585 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2586 cd write(iout,*) 'muij',muij
2587 ury=scalar(uy(1,i),erij)
2588 urz=scalar(uz(1,i),erij)
2589 vry=scalar(uy(1,j),erij)
2590 vrz=scalar(uz(1,j),erij)
2591 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2592 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2593 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2594 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2595 C For diagnostics only
2600 fac=dsqrt(-ael6i)*r3ij
2601 cd write (2,*) 'fac=',fac
2602 C For diagnostics only
2608 cd write (iout,'(4i5,4f10.5)')
2609 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2610 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2611 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2612 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2613 cd write (iout,'(4f10.5)')
2614 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2615 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2616 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2617 cd write (iout,'(2i3,9f10.5/)') i,j,
2618 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2620 C Derivatives of the elements of A in virtual-bond vectors
2621 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2628 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2629 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2630 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2631 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2632 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2633 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2634 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2635 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2636 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2637 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2638 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2639 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2649 C Compute radial contributions to the gradient
2671 C Add the contributions coming from er
2674 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2675 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2676 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2677 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2680 C Derivatives in DC(i)
2681 ghalf1=0.5d0*agg(k,1)
2682 ghalf2=0.5d0*agg(k,2)
2683 ghalf3=0.5d0*agg(k,3)
2684 ghalf4=0.5d0*agg(k,4)
2685 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2686 & -3.0d0*uryg(k,2)*vry)+ghalf1
2687 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2688 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2689 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2690 & -3.0d0*urzg(k,2)*vry)+ghalf3
2691 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2692 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2693 C Derivatives in DC(i+1)
2694 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2695 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2696 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2697 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2698 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2699 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2700 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2701 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2702 C Derivatives in DC(j)
2703 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2704 & -3.0d0*vryg(k,2)*ury)+ghalf1
2705 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2706 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2707 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2708 & -3.0d0*vryg(k,2)*urz)+ghalf3
2709 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2710 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2711 C Derivatives in DC(j+1) or DC(nres-1)
2712 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2713 & -3.0d0*vryg(k,3)*ury)
2714 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2715 & -3.0d0*vrzg(k,3)*ury)
2716 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2717 & -3.0d0*vryg(k,3)*urz)
2718 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2719 & -3.0d0*vrzg(k,3)*urz)
2724 C Derivatives in DC(i+1)
2725 cd aggi1(k,1)=agg(k,1)
2726 cd aggi1(k,2)=agg(k,2)
2727 cd aggi1(k,3)=agg(k,3)
2728 cd aggi1(k,4)=agg(k,4)
2729 C Derivatives in DC(j)
2734 C Derivatives in DC(j+1)
2739 if (j.eq.nres-1 .and. i.lt.j-2) then
2741 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2742 cd aggj1(k,l)=agg(k,l)
2748 C Check the loc-el terms by numerical integration
2758 aggi(k,l)=-aggi(k,l)
2759 aggi1(k,l)=-aggi1(k,l)
2760 aggj(k,l)=-aggj(k,l)
2761 aggj1(k,l)=-aggj1(k,l)
2764 if (j.lt.nres-1) then
2770 aggi(k,l)=-aggi(k,l)
2771 aggi1(k,l)=-aggi1(k,l)
2772 aggj(k,l)=-aggj(k,l)
2773 aggj1(k,l)=-aggj1(k,l)
2784 aggi(k,l)=-aggi(k,l)
2785 aggi1(k,l)=-aggi1(k,l)
2786 aggj(k,l)=-aggj(k,l)
2787 aggj1(k,l)=-aggj1(k,l)
2793 IF (wel_loc.gt.0.0d0) THEN
2794 C Contribution to the local-electrostatic energy coming from the i-j pair
2795 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2797 if (shield_mode.eq.0) then
2804 eel_loc_ij=eel_loc_ij
2805 & *fac_shield(i)*fac_shield(j)
2806 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2807 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2808 C write (iout,'(a6,2i5,0pf7.3)')
2809 C & 'eelloc',i,j,eel_loc_ij
2810 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2811 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2812 C eel_loc=eel_loc+eel_loc_ij
2813 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2814 & (shield_mode.gt.0)) then
2817 do ilist=1,ishield_list(i)
2818 iresshield=shield_list(ilist,i)
2820 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2823 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2825 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2826 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2830 do ilist=1,ishield_list(j)
2831 iresshield=shield_list(ilist,j)
2833 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2836 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2838 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2839 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2845 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2846 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2847 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2848 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2849 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2850 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2851 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2852 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2855 eel_loc=eel_loc+eel_loc_ij
2857 C Partial derivatives in virtual-bond dihedral angles gamma
2860 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2861 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2862 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
2863 & *fac_shield(i)*fac_shield(j)
2864 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2866 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2867 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2868 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
2869 & *fac_shield(i)*fac_shield(j)
2870 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2872 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2873 cd write(iout,*) 'agg ',agg
2874 cd write(iout,*) 'aggi ',aggi
2875 cd write(iout,*) 'aggi1',aggi1
2876 cd write(iout,*) 'aggj ',aggj
2877 cd write(iout,*) 'aggj1',aggj1
2879 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2881 ggg(l)=(agg(l,1)*muij(1)+
2882 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
2883 & *fac_shield(i)*fac_shield(j)
2884 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2889 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2892 C Remaining derivatives of eello
2894 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
2895 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
2896 & *fac_shield(i)*fac_shield(j)
2897 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2899 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
2900 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
2901 & *fac_shield(i)*fac_shield(j)
2902 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2904 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
2905 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
2906 & *fac_shield(i)*fac_shield(j)
2907 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2909 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
2910 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
2911 & *fac_shield(i)*fac_shield(j)
2912 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2917 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2918 C Contributions from turns
2923 call eturn34(i,j,eello_turn3,eello_turn4)
2925 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2926 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2928 C Calculate the contact function. The ith column of the array JCONT will
2929 C contain the numbers of atoms that make contacts with the atom I (of numbers
2930 C greater than I). The arrays FACONT and GACONT will contain the values of
2931 C the contact function and its derivative.
2932 c r0ij=1.02D0*rpp(iteli,itelj)
2933 c r0ij=1.11D0*rpp(iteli,itelj)
2934 r0ij=2.20D0*rpp(iteli,itelj)
2935 c r0ij=1.55D0*rpp(iteli,itelj)
2936 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2937 if (fcont.gt.0.0D0) then
2938 num_conti=num_conti+1
2939 if (num_conti.gt.maxconts) then
2940 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2941 & ' will skip next contacts for this conf.'
2943 jcont_hb(num_conti,i)=j
2944 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2945 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2946 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2948 d_cont(num_conti,i)=rij
2949 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2950 C --- Electrostatic-interaction matrix ---
2951 a_chuj(1,1,num_conti,i)=a22
2952 a_chuj(1,2,num_conti,i)=a23
2953 a_chuj(2,1,num_conti,i)=a32
2954 a_chuj(2,2,num_conti,i)=a33
2955 C --- Gradient of rij
2957 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2960 c a_chuj(1,1,num_conti,i)=-0.61d0
2961 c a_chuj(1,2,num_conti,i)= 0.4d0
2962 c a_chuj(2,1,num_conti,i)= 0.65d0
2963 c a_chuj(2,2,num_conti,i)= 0.50d0
2964 c else if (i.eq.2) then
2965 c a_chuj(1,1,num_conti,i)= 0.0d0
2966 c a_chuj(1,2,num_conti,i)= 0.0d0
2967 c a_chuj(2,1,num_conti,i)= 0.0d0
2968 c a_chuj(2,2,num_conti,i)= 0.0d0
2970 C --- and its gradients
2971 cd write (iout,*) 'i',i,' j',j
2973 cd write (iout,*) 'iii 1 kkk',kkk
2974 cd write (iout,*) agg(kkk,:)
2977 cd write (iout,*) 'iii 2 kkk',kkk
2978 cd write (iout,*) aggi(kkk,:)
2981 cd write (iout,*) 'iii 3 kkk',kkk
2982 cd write (iout,*) aggi1(kkk,:)
2985 cd write (iout,*) 'iii 4 kkk',kkk
2986 cd write (iout,*) aggj(kkk,:)
2989 cd write (iout,*) 'iii 5 kkk',kkk
2990 cd write (iout,*) aggj1(kkk,:)
2997 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2998 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2999 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3000 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3001 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3003 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
3009 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3010 C Calculate contact energies
3012 wij=cosa-3.0D0*cosb*cosg
3015 c fac3=dsqrt(-ael6i)/r0ij**3
3016 fac3=dsqrt(-ael6i)*r3ij
3017 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3018 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3020 if (shield_mode.eq.0) then
3024 ees0plist(num_conti,i)=j
3025 C fac_shield(i)=0.4d0
3026 C fac_shield(j)=0.6d0
3028 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3029 & *fac_shield(i)*fac_shield(j)
3031 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3032 & *fac_shield(i)*fac_shield(j)
3034 C Diagnostics. Comment out or remove after debugging!
3035 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3036 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3037 c ees0m(num_conti,i)=0.0D0
3039 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3040 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3041 facont_hb(num_conti,i)=fcont
3043 C Angular derivatives of the contact function
3044 ees0pij1=fac3/ees0pij
3045 ees0mij1=fac3/ees0mij
3046 fac3p=-3.0D0*fac3*rrmij
3047 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3048 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3050 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3051 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3052 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3053 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3054 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3055 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3056 ecosap=ecosa1+ecosa2
3057 ecosbp=ecosb1+ecosb2
3058 ecosgp=ecosg1+ecosg2
3059 ecosam=ecosa1-ecosa2
3060 ecosbm=ecosb1-ecosb2
3061 ecosgm=ecosg1-ecosg2
3070 fprimcont=fprimcont/rij
3071 cd facont_hb(num_conti,i)=1.0D0
3072 C Following line is for diagnostics.
3075 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3076 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3079 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3080 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3082 gggp(1)=gggp(1)+ees0pijp*xj
3083 gggp(2)=gggp(2)+ees0pijp*yj
3084 gggp(3)=gggp(3)+ees0pijp*zj
3085 gggm(1)=gggm(1)+ees0mijp*xj
3086 gggm(2)=gggm(2)+ees0mijp*yj
3087 gggm(3)=gggm(3)+ees0mijp*zj
3088 C Derivatives due to the contact function
3089 gacont_hbr(1,num_conti,i)=fprimcont*xj
3090 gacont_hbr(2,num_conti,i)=fprimcont*yj
3091 gacont_hbr(3,num_conti,i)=fprimcont*zj
3093 ghalfp=0.5D0*gggp(k)
3094 ghalfm=0.5D0*gggm(k)
3095 gacontp_hb1(k,num_conti,i)=ghalfp
3096 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3097 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3098 & *fac_shield(i)*fac_shield(j)
3100 gacontp_hb2(k,num_conti,i)=ghalfp
3101 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3102 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3103 & *fac_shield(i)*fac_shield(j)
3105 gacontp_hb3(k,num_conti,i)=gggp(k)
3106 & *fac_shield(i)*fac_shield(j)
3108 gacontm_hb1(k,num_conti,i)=ghalfm
3109 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3110 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3111 & *fac_shield(i)*fac_shield(j)
3113 gacontm_hb2(k,num_conti,i)=ghalfm
3114 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3115 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3116 & *fac_shield(i)*fac_shield(j)
3118 gacontm_hb3(k,num_conti,i)=gggm(k)
3119 & *fac_shield(i)*fac_shield(j)
3123 C Diagnostics. Comment out or remove after debugging!
3125 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3126 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3127 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3128 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3129 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3130 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3133 endif ! num_conti.le.maxconts
3138 num_cont_hb(i)=num_conti
3142 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3143 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3145 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3146 ccc eel_loc=eel_loc+eello_turn3
3149 C-----------------------------------------------------------------------------
3150 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3151 C Third- and fourth-order contributions from turns
3152 implicit real*8 (a-h,o-z)
3153 include 'DIMENSIONS'
3154 include 'DIMENSIONS.ZSCOPT'
3155 include 'COMMON.IOUNITS'
3156 include 'COMMON.GEO'
3157 include 'COMMON.VAR'
3158 include 'COMMON.LOCAL'
3159 include 'COMMON.CHAIN'
3160 include 'COMMON.DERIV'
3161 include 'COMMON.INTERACT'
3162 include 'COMMON.CONTACTS'
3163 include 'COMMON.TORSION'
3164 include 'COMMON.VECTORS'
3165 include 'COMMON.FFIELD'
3166 include 'COMMON.SHIELD'
3167 include 'COMMON.CONTROL'
3169 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3170 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3171 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3172 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3173 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3174 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3175 zj=(c(3,j)+c(3,j+1))/2.0d0
3176 C xj=mod(xj,boxxsize)
3177 C if (xj.lt.0) xj=xj+boxxsize
3178 C yj=mod(yj,boxysize)
3179 C if (yj.lt.0) yj=yj+boxysize
3181 if (zj.lt.0) zj=zj+boxzsize
3182 C if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3183 if ((zj.gt.bordlipbot)
3184 &.and.(zj.lt.bordliptop)) then
3185 C the energy transfer exist
3186 if (zj.lt.buflipbot) then
3187 C what fraction I am in
3189 & ((zj-bordlipbot)/lipbufthick)
3190 C lipbufthick is thickenes of lipid buffore
3191 sslipj=sscalelip(fracinbuf)
3192 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3193 elseif (zj.gt.bufliptop) then
3194 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3195 sslipj=sscalelip(fracinbuf)
3196 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3207 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3208 C changes suggested by Ana to avoid out of bounds
3209 C & .or.((i+5).gt.nres)
3210 C & .or.((i-1).le.0)
3211 C end of changes suggested by Ana
3212 & .or. itype(i+2).eq.ntyp1
3213 & .or. itype(i+3).eq.ntyp1
3214 C & .or. itype(i+5).eq.ntyp1
3215 C & .or. itype(i).eq.ntyp1
3216 C & .or. itype(i-1).eq.ntyp1
3219 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3221 C Third-order contributions
3228 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3229 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3230 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3231 call transpose2(auxmat(1,1),auxmat1(1,1))
3232 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3233 if (shield_mode.eq.0) then
3241 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3242 & *fac_shield(i)*fac_shield(j)
3243 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3245 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3246 & *fac_shield(i)*fac_shield(j)
3247 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3249 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3250 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3251 cd & ' eello_turn3_num',4*eello_turn3_num
3253 C Derivatives in shield mode
3254 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3255 & (shield_mode.gt.0)) then
3258 do ilist=1,ishield_list(i)
3259 iresshield=shield_list(ilist,i)
3261 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3263 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3265 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3266 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3270 do ilist=1,ishield_list(j)
3271 iresshield=shield_list(ilist,j)
3273 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3275 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3277 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3278 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3285 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3286 & grad_shield(k,i)*eello_t3/fac_shield(i)
3287 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3288 & grad_shield(k,j)*eello_t3/fac_shield(j)
3289 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3290 & grad_shield(k,i)*eello_t3/fac_shield(i)
3291 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3292 & grad_shield(k,j)*eello_t3/fac_shield(j)
3296 C Derivatives in gamma(i)
3297 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3298 call transpose2(auxmat2(1,1),pizda(1,1))
3299 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3300 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3301 & *fac_shield(i)*fac_shield(j)
3302 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3304 C Derivatives in gamma(i+1)
3305 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3306 call transpose2(auxmat2(1,1),pizda(1,1))
3307 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3308 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3309 & +0.5d0*(pizda(1,1)+pizda(2,2))
3310 & *fac_shield(i)*fac_shield(j)
3311 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3313 C Cartesian derivatives
3315 a_temp(1,1)=aggi(l,1)
3316 a_temp(1,2)=aggi(l,2)
3317 a_temp(2,1)=aggi(l,3)
3318 a_temp(2,2)=aggi(l,4)
3319 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3320 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3321 & +0.5d0*(pizda(1,1)+pizda(2,2))
3322 & *fac_shield(i)*fac_shield(j)
3323 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3325 a_temp(1,1)=aggi1(l,1)
3326 a_temp(1,2)=aggi1(l,2)
3327 a_temp(2,1)=aggi1(l,3)
3328 a_temp(2,2)=aggi1(l,4)
3329 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3330 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3331 & +0.5d0*(pizda(1,1)+pizda(2,2))
3332 & *fac_shield(i)*fac_shield(j)
3333 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3335 a_temp(1,1)=aggj(l,1)
3336 a_temp(1,2)=aggj(l,2)
3337 a_temp(2,1)=aggj(l,3)
3338 a_temp(2,2)=aggj(l,4)
3339 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3340 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3341 & +0.5d0*(pizda(1,1)+pizda(2,2))
3342 & *fac_shield(i)*fac_shield(j)
3343 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3345 a_temp(1,1)=aggj1(l,1)
3346 a_temp(1,2)=aggj1(l,2)
3347 a_temp(2,1)=aggj1(l,3)
3348 a_temp(2,2)=aggj1(l,4)
3349 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3350 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3351 & +0.5d0*(pizda(1,1)+pizda(2,2))
3352 & *fac_shield(i)*fac_shield(j)
3353 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3358 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3359 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3360 C changes suggested by Ana to avoid out of bounds
3361 C & .or.((i+5).gt.nres)
3362 C & .or.((i-1).le.0)
3363 C end of changes suggested by Ana
3364 & .or. itype(i+3).eq.ntyp1
3365 & .or. itype(i+4).eq.ntyp1
3366 C & .or. itype(i+5).eq.ntyp1
3367 & .or. itype(i).eq.ntyp1
3368 C & .or. itype(i-1).eq.ntyp1
3370 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3372 C Fourth-order contributions
3380 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3381 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3382 iti1=itortyp(itype(i+1))
3383 iti2=itortyp(itype(i+2))
3384 iti3=itortyp(itype(i+3))
3385 call transpose2(EUg(1,1,i+1),e1t(1,1))
3386 call transpose2(Eug(1,1,i+2),e2t(1,1))
3387 call transpose2(Eug(1,1,i+3),e3t(1,1))
3388 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3389 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3390 s1=scalar2(b1(1,iti2),auxvec(1))
3391 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3392 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3393 s2=scalar2(b1(1,iti1),auxvec(1))
3394 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3395 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3396 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3397 if (shield_mode.eq.0) then
3405 eello_turn4=eello_turn4-(s1+s2+s3)
3406 & *fac_shield(i)*fac_shield(j)
3407 eello_t4=-(s1+s2+s3)
3408 & *fac_shield(i)*fac_shield(j)
3410 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3411 cd & ' eello_turn4_num',8*eello_turn4_num
3412 C Derivatives in gamma(i)
3414 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3415 & (shield_mode.gt.0)) then
3418 do ilist=1,ishield_list(i)
3419 iresshield=shield_list(ilist,i)
3421 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3423 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3425 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3426 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3430 do ilist=1,ishield_list(j)
3431 iresshield=shield_list(ilist,j)
3433 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3435 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3437 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3438 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3445 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3446 & grad_shield(k,i)*eello_t4/fac_shield(i)
3447 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3448 & grad_shield(k,j)*eello_t4/fac_shield(j)
3449 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3450 & grad_shield(k,i)*eello_t4/fac_shield(i)
3451 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3452 & grad_shield(k,j)*eello_t4/fac_shield(j)
3455 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3456 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3457 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3458 s1=scalar2(b1(1,iti2),auxvec(1))
3459 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3460 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3461 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3462 & *fac_shield(i)*fac_shield(j)
3463 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3465 C Derivatives in gamma(i+1)
3466 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3467 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3468 s2=scalar2(b1(1,iti1),auxvec(1))
3469 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3470 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3471 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3472 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3473 & *fac_shield(i)*fac_shield(j)
3474 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3476 C Derivatives in gamma(i+2)
3477 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3478 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3479 s1=scalar2(b1(1,iti2),auxvec(1))
3480 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3481 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3482 s2=scalar2(b1(1,iti1),auxvec(1))
3483 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3484 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3485 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3486 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3487 & *fac_shield(i)*fac_shield(j)
3488 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3490 C Cartesian derivatives
3492 C Derivatives of this turn contributions in DC(i+2)
3493 if (j.lt.nres-1) then
3495 a_temp(1,1)=agg(l,1)
3496 a_temp(1,2)=agg(l,2)
3497 a_temp(2,1)=agg(l,3)
3498 a_temp(2,2)=agg(l,4)
3499 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3500 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3501 s1=scalar2(b1(1,iti2),auxvec(1))
3502 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3503 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3504 s2=scalar2(b1(1,iti1),auxvec(1))
3505 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3506 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3507 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3509 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3510 & *fac_shield(i)*fac_shield(j)
3511 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3515 C Remaining derivatives of this turn contribution
3517 a_temp(1,1)=aggi(l,1)
3518 a_temp(1,2)=aggi(l,2)
3519 a_temp(2,1)=aggi(l,3)
3520 a_temp(2,2)=aggi(l,4)
3521 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3522 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3523 s1=scalar2(b1(1,iti2),auxvec(1))
3524 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3525 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3526 s2=scalar2(b1(1,iti1),auxvec(1))
3527 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3528 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3529 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3530 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3531 & *fac_shield(i)*fac_shield(j)
3532 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3534 a_temp(1,1)=aggi1(l,1)
3535 a_temp(1,2)=aggi1(l,2)
3536 a_temp(2,1)=aggi1(l,3)
3537 a_temp(2,2)=aggi1(l,4)
3538 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3539 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3540 s1=scalar2(b1(1,iti2),auxvec(1))
3541 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3542 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3543 s2=scalar2(b1(1,iti1),auxvec(1))
3544 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3545 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3546 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3547 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3548 & *fac_shield(i)*fac_shield(j)
3549 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3551 a_temp(1,1)=aggj(l,1)
3552 a_temp(1,2)=aggj(l,2)
3553 a_temp(2,1)=aggj(l,3)
3554 a_temp(2,2)=aggj(l,4)
3555 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3556 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3557 s1=scalar2(b1(1,iti2),auxvec(1))
3558 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3559 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3560 s2=scalar2(b1(1,iti1),auxvec(1))
3561 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3562 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3563 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3564 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3565 & *fac_shield(i)*fac_shield(j)
3566 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3568 a_temp(1,1)=aggj1(l,1)
3569 a_temp(1,2)=aggj1(l,2)
3570 a_temp(2,1)=aggj1(l,3)
3571 a_temp(2,2)=aggj1(l,4)
3572 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3573 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3574 s1=scalar2(b1(1,iti2),auxvec(1))
3575 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3576 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3577 s2=scalar2(b1(1,iti1),auxvec(1))
3578 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3579 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3580 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3581 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3582 & *fac_shield(i)*fac_shield(j)
3583 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3586 gshieldc_t4(3,i)=gshieldc_t4(3,i)+
3587 & ssgradlipi*eello_t4/4.0d0*lipscale
3588 gshieldc_t4(3,j)=gshieldc_t4(3,j)+
3589 & ssgradlipj*eello_t4/4.0d0*lipscale
3590 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+
3591 & ssgradlipi*eello_t4/4.0d0*lipscale
3592 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+
3593 & ssgradlipj*eello_t4/4.0d0*lipscale
3599 C-----------------------------------------------------------------------------
3600 subroutine vecpr(u,v,w)
3601 implicit real*8(a-h,o-z)
3602 dimension u(3),v(3),w(3)
3603 w(1)=u(2)*v(3)-u(3)*v(2)
3604 w(2)=-u(1)*v(3)+u(3)*v(1)
3605 w(3)=u(1)*v(2)-u(2)*v(1)
3608 C-----------------------------------------------------------------------------
3609 subroutine unormderiv(u,ugrad,unorm,ungrad)
3610 C This subroutine computes the derivatives of a normalized vector u, given
3611 C the derivatives computed without normalization conditions, ugrad. Returns
3614 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3615 double precision vec(3)
3616 double precision scalar
3618 c write (2,*) 'ugrad',ugrad
3621 vec(i)=scalar(ugrad(1,i),u(1))
3623 c write (2,*) 'vec',vec
3626 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3629 c write (2,*) 'ungrad',ungrad
3632 C-----------------------------------------------------------------------------
3633 subroutine escp(evdw2,evdw2_14)
3635 C This subroutine calculates the excluded-volume interaction energy between
3636 C peptide-group centers and side chains and its gradient in virtual-bond and
3637 C side-chain vectors.
3639 implicit real*8 (a-h,o-z)
3640 include 'DIMENSIONS'
3641 include 'DIMENSIONS.ZSCOPT'
3642 include 'COMMON.GEO'
3643 include 'COMMON.VAR'
3644 include 'COMMON.LOCAL'
3645 include 'COMMON.CHAIN'
3646 include 'COMMON.DERIV'
3647 include 'COMMON.INTERACT'
3648 include 'COMMON.FFIELD'
3649 include 'COMMON.IOUNITS'
3653 cd print '(a)','Enter ESCP'
3654 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3655 c & ' scal14',scal14
3656 do i=iatscp_s,iatscp_e
3657 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3659 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3660 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3661 if (iteli.eq.0) goto 1225
3662 xi=0.5D0*(c(1,i)+c(1,i+1))
3663 yi=0.5D0*(c(2,i)+c(2,i+1))
3664 zi=0.5D0*(c(3,i)+c(3,i+1))
3665 C Returning the ith atom to box
3667 if (xi.lt.0) xi=xi+boxxsize
3669 if (yi.lt.0) yi=yi+boxysize
3671 if (zi.lt.0) zi=zi+boxzsize
3672 do iint=1,nscp_gr(i)
3674 do j=iscpstart(i,iint),iscpend(i,iint)
3675 itypj=iabs(itype(j))
3676 if (itypj.eq.ntyp1) cycle
3677 C Uncomment following three lines for SC-p interactions
3681 C Uncomment following three lines for Ca-p interactions
3685 C returning the jth atom to box
3687 if (xj.lt.0) xj=xj+boxxsize
3689 if (yj.lt.0) yj=yj+boxysize
3691 if (zj.lt.0) zj=zj+boxzsize
3692 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3697 C Finding the closest jth atom
3701 xj=xj_safe+xshift*boxxsize
3702 yj=yj_safe+yshift*boxysize
3703 zj=zj_safe+zshift*boxzsize
3704 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3705 if(dist_temp.lt.dist_init) then
3715 if (subchap.eq.1) then
3724 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3725 C sss is scaling function for smoothing the cutoff gradient otherwise
3726 C the gradient would not be continuouse
3727 sss=sscale(1.0d0/(dsqrt(rrij)))
3728 if (sss.le.0.0d0) cycle
3729 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3731 e1=fac*fac*aad(itypj,iteli)
3732 e2=fac*bad(itypj,iteli)
3733 if (iabs(j-i) .le. 2) then
3736 evdw2_14=evdw2_14+(e1+e2)*sss
3739 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3740 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3741 c & bad(itypj,iteli)
3742 evdw2=evdw2+evdwij*sss
3745 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3747 fac=-(evdwij+e1)*rrij*sss
3748 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3753 cd write (iout,*) 'j<i'
3754 C Uncomment following three lines for SC-p interactions
3756 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3759 cd write (iout,*) 'j>i'
3762 C Uncomment following line for SC-p interactions
3763 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3767 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3771 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3772 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3775 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3785 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3786 gradx_scp(j,i)=expon*gradx_scp(j,i)
3789 C******************************************************************************
3793 C To save time the factor EXPON has been extracted from ALL components
3794 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3797 C******************************************************************************
3800 C--------------------------------------------------------------------------
3801 subroutine edis(ehpb)
3803 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3805 implicit real*8 (a-h,o-z)
3806 include 'DIMENSIONS'
3807 include 'DIMENSIONS.ZSCOPT'
3808 include 'COMMON.SBRIDGE'
3809 include 'COMMON.CHAIN'
3810 include 'COMMON.DERIV'
3811 include 'COMMON.VAR'
3812 include 'COMMON.INTERACT'
3813 include 'COMMON.CONTROL'
3814 include 'COMMON.IOUNITS'
3817 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3818 cd print *,'link_start=',link_start,' link_end=',link_end
3819 C write(iout,*) link_end, "link_end"
3820 if (link_end.eq.0) return
3821 do i=link_start,link_end
3822 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3823 C CA-CA distance used in regularization of structure.
3826 C iii and jjj point to the residues for which the distance is assigned.
3827 if (ii.gt.nres) then
3834 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3835 C distance and angle dependent SS bond potential.
3836 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3837 C & iabs(itype(jjj)).eq.1) then
3838 C write(iout,*) constr_dist,"const"
3839 if (.not.dyn_ss .and. i.le.nss) then
3840 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3841 & iabs(itype(jjj)).eq.1) then
3842 call ssbond_ene(iii,jjj,eij)
3845 else if (ii.gt.nres .and. jj.gt.nres) then
3846 c Restraints from contact prediction
3848 if (constr_dist.eq.11) then
3849 C ehpb=ehpb+fordepth(i)**4.0d0
3850 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3851 ehpb=ehpb+fordepth(i)**4.0d0
3852 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3853 fac=fordepth(i)**4.0d0
3854 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3855 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3856 C & ehpb,fordepth(i),dd
3857 C write(iout,*) ehpb,"atu?"
3859 C fac=fordepth(i)**4.0d0
3860 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3862 if (dhpb1(i).gt.0.0d0) then
3863 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3864 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3865 c write (iout,*) "beta nmr",
3866 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3870 C Get the force constant corresponding to this distance.
3872 C Calculate the contribution to energy.
3873 ehpb=ehpb+waga*rdis*rdis
3874 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3876 C Evaluate gradient.
3879 endif !end dhpb1(i).gt.0
3880 endif !end const_dist=11
3882 ggg(j)=fac*(c(j,jj)-c(j,ii))
3885 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3886 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3889 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3890 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3893 C write(iout,*) "before"
3895 C write(iout,*) "after",dd
3896 if (constr_dist.eq.11) then
3897 ehpb=ehpb+fordepth(i)**4.0d0
3898 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3899 fac=fordepth(i)**4.0d0
3900 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3901 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3902 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3903 C print *,ehpb,"tu?"
3904 C write(iout,*) ehpb,"btu?",
3905 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3906 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3907 C & ehpb,fordepth(i),dd
3909 if (dhpb1(i).gt.0.0d0) then
3910 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3911 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3912 c write (iout,*) "alph nmr",
3913 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3916 C Get the force constant corresponding to this distance.
3918 C Calculate the contribution to energy.
3919 ehpb=ehpb+waga*rdis*rdis
3920 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3922 C Evaluate gradient.
3929 ggg(j)=fac*(c(j,jj)-c(j,ii))
3931 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3932 C If this is a SC-SC distance, we need to calculate the contributions to the
3933 C Cartesian gradient in the SC vectors (ghpbx).
3936 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3937 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3942 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3947 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3950 C--------------------------------------------------------------------------
3951 subroutine ssbond_ene(i,j,eij)
3953 C Calculate the distance and angle dependent SS-bond potential energy
3954 C using a free-energy function derived based on RHF/6-31G** ab initio
3955 C calculations of diethyl disulfide.
3957 C A. Liwo and U. Kozlowska, 11/24/03
3959 implicit real*8 (a-h,o-z)
3960 include 'DIMENSIONS'
3961 include 'DIMENSIONS.ZSCOPT'
3962 include 'COMMON.SBRIDGE'
3963 include 'COMMON.CHAIN'
3964 include 'COMMON.DERIV'
3965 include 'COMMON.LOCAL'
3966 include 'COMMON.INTERACT'
3967 include 'COMMON.VAR'
3968 include 'COMMON.IOUNITS'
3969 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3970 itypi=iabs(itype(i))
3974 dxi=dc_norm(1,nres+i)
3975 dyi=dc_norm(2,nres+i)
3976 dzi=dc_norm(3,nres+i)
3977 dsci_inv=dsc_inv(itypi)
3978 itypj=iabs(itype(j))
3979 dscj_inv=dsc_inv(itypj)
3983 dxj=dc_norm(1,nres+j)
3984 dyj=dc_norm(2,nres+j)
3985 dzj=dc_norm(3,nres+j)
3986 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3991 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3992 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3993 om12=dxi*dxj+dyi*dyj+dzi*dzj
3995 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3996 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4002 deltat12=om2-om1+2.0d0
4004 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4005 & +akct*deltad*deltat12
4006 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4007 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4008 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4009 c & " deltat12",deltat12," eij",eij
4010 ed=2*akcm*deltad+akct*deltat12
4012 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4013 eom1=-2*akth*deltat1-pom1-om2*pom2
4014 eom2= 2*akth*deltat2+pom1-om1*pom2
4017 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4020 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4021 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4022 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4023 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4026 C Calculate the components of the gradient in DC and X
4030 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4035 C--------------------------------------------------------------------------
4036 subroutine ebond(estr)
4038 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4040 implicit real*8 (a-h,o-z)
4041 include 'DIMENSIONS'
4042 include 'DIMENSIONS.ZSCOPT'
4043 include 'COMMON.LOCAL'
4044 include 'COMMON.GEO'
4045 include 'COMMON.INTERACT'
4046 include 'COMMON.DERIV'
4047 include 'COMMON.VAR'
4048 include 'COMMON.CHAIN'
4049 include 'COMMON.IOUNITS'
4050 include 'COMMON.NAMES'
4051 include 'COMMON.FFIELD'
4052 include 'COMMON.CONTROL'
4053 logical energy_dec /.false./
4054 double precision u(3),ud(3)
4057 c write (iout,*) "distchainmax",distchainmax
4059 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4060 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4062 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4063 C & *dc(j,i-1)/vbld(i)
4065 C if (energy_dec) write(iout,*)
4066 C & "estr1",i,vbld(i),distchainmax,
4067 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4069 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4070 diff = vbld(i)-vbldpDUM
4071 C write(iout,*) i,diff
4073 diff = vbld(i)-vbldp0
4074 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4078 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4081 C write (iout,'(a7,i5,4f7.3)')
4082 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4084 estr=0.5d0*AKP*estr+estr1
4086 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4090 if (iti.ne.10 .and. iti.ne.ntyp1) then
4093 diff=vbld(i+nres)-vbldsc0(1,iti)
4094 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4095 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4096 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4098 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4102 diff=vbld(i+nres)-vbldsc0(j,iti)
4103 ud(j)=aksc(j,iti)*diff
4104 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4118 uprod2=uprod2*u(k)*u(k)
4122 usumsqder=usumsqder+ud(j)*uprod2
4124 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4125 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4126 estr=estr+uprod/usum
4128 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4136 C--------------------------------------------------------------------------
4137 subroutine ebend(etheta,ethetacnstr)
4139 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4140 C angles gamma and its derivatives in consecutive thetas and gammas.
4142 implicit real*8 (a-h,o-z)
4143 include 'DIMENSIONS'
4144 include 'DIMENSIONS.ZSCOPT'
4145 include 'COMMON.LOCAL'
4146 include 'COMMON.GEO'
4147 include 'COMMON.INTERACT'
4148 include 'COMMON.DERIV'
4149 include 'COMMON.VAR'
4150 include 'COMMON.CHAIN'
4151 include 'COMMON.IOUNITS'
4152 include 'COMMON.NAMES'
4153 include 'COMMON.FFIELD'
4154 include 'COMMON.TORCNSTR'
4155 common /calcthet/ term1,term2,termm,diffak,ratak,
4156 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4157 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4158 double precision y(2),z(2)
4160 c time11=dexp(-2*time)
4163 c write (iout,*) "nres",nres
4164 c write (*,'(a,i2)') 'EBEND ICG=',icg
4165 c write (iout,*) ithet_start,ithet_end
4166 do i=ithet_start,ithet_end
4167 C if (itype(i-1).eq.ntyp1) cycle
4169 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4170 & .or.itype(i).eq.ntyp1) cycle
4171 C Zero the energy function and its derivative at 0 or pi.
4172 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4174 ichir1=isign(1,itype(i-2))
4175 ichir2=isign(1,itype(i))
4176 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4177 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4178 if (itype(i-1).eq.10) then
4179 itype1=isign(10,itype(i-2))
4180 ichir11=isign(1,itype(i-2))
4181 ichir12=isign(1,itype(i-2))
4182 itype2=isign(10,itype(i))
4183 ichir21=isign(1,itype(i))
4184 ichir22=isign(1,itype(i))
4191 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4195 c call proc_proc(phii,icrc)
4196 if (icrc.eq.1) phii=150.0
4207 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4211 c call proc_proc(phii1,icrc)
4212 if (icrc.eq.1) phii1=150.0
4224 C Calculate the "mean" value of theta from the part of the distribution
4225 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4226 C In following comments this theta will be referred to as t_c.
4227 thet_pred_mean=0.0d0
4229 athetk=athet(k,it,ichir1,ichir2)
4230 bthetk=bthet(k,it,ichir1,ichir2)
4232 athetk=athet(k,itype1,ichir11,ichir12)
4233 bthetk=bthet(k,itype2,ichir21,ichir22)
4235 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4237 c write (iout,*) "thet_pred_mean",thet_pred_mean
4238 dthett=thet_pred_mean*ssd
4239 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4240 c write (iout,*) "thet_pred_mean",thet_pred_mean
4241 C Derivatives of the "mean" values in gamma1 and gamma2.
4242 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4243 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4244 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4245 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4247 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4248 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4249 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4250 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4252 if (theta(i).gt.pi-delta) then
4253 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4255 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4256 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4257 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4259 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4261 else if (theta(i).lt.delta) then
4262 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4263 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4264 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4266 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4267 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4270 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4273 etheta=etheta+ethetai
4274 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4275 c & 'ebend',i,ethetai,theta(i),itype(i)
4276 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4277 c & rad2deg*phii,rad2deg*phii1,ethetai
4278 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4279 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4280 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4284 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4285 do i=1,ntheta_constr
4286 itheta=itheta_constr(i)
4287 thetiii=theta(itheta)
4288 difi=pinorm(thetiii-theta_constr0(i))
4289 if (difi.gt.theta_drange(i)) then
4290 difi=difi-theta_drange(i)
4291 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4292 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4293 & +for_thet_constr(i)*difi**3
4294 else if (difi.lt.-drange(i)) then
4296 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4297 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4298 & +for_thet_constr(i)*difi**3
4302 C if (energy_dec) then
4303 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4304 C & i,itheta,rad2deg*thetiii,
4305 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4306 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4307 C & gloc(itheta+nphi-2,icg)
4310 C Ufff.... We've done all this!!!
4313 C---------------------------------------------------------------------------
4314 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4316 implicit real*8 (a-h,o-z)
4317 include 'DIMENSIONS'
4318 include 'COMMON.LOCAL'
4319 include 'COMMON.IOUNITS'
4320 common /calcthet/ term1,term2,termm,diffak,ratak,
4321 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4322 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4323 C Calculate the contributions to both Gaussian lobes.
4324 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4325 C The "polynomial part" of the "standard deviation" of this part of
4329 sig=sig*thet_pred_mean+polthet(j,it)
4331 C Derivative of the "interior part" of the "standard deviation of the"
4332 C gamma-dependent Gaussian lobe in t_c.
4333 sigtc=3*polthet(3,it)
4335 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4338 C Set the parameters of both Gaussian lobes of the distribution.
4339 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4340 fac=sig*sig+sigc0(it)
4343 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4344 sigsqtc=-4.0D0*sigcsq*sigtc
4345 c print *,i,sig,sigtc,sigsqtc
4346 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4347 sigtc=-sigtc/(fac*fac)
4348 C Following variable is sigma(t_c)**(-2)
4349 sigcsq=sigcsq*sigcsq
4351 sig0inv=1.0D0/sig0i**2
4352 delthec=thetai-thet_pred_mean
4353 delthe0=thetai-theta0i
4354 term1=-0.5D0*sigcsq*delthec*delthec
4355 term2=-0.5D0*sig0inv*delthe0*delthe0
4356 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4357 C NaNs in taking the logarithm. We extract the largest exponent which is added
4358 C to the energy (this being the log of the distribution) at the end of energy
4359 C term evaluation for this virtual-bond angle.
4360 if (term1.gt.term2) then
4362 term2=dexp(term2-termm)
4366 term1=dexp(term1-termm)
4369 C The ratio between the gamma-independent and gamma-dependent lobes of
4370 C the distribution is a Gaussian function of thet_pred_mean too.
4371 diffak=gthet(2,it)-thet_pred_mean
4372 ratak=diffak/gthet(3,it)**2
4373 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4374 C Let's differentiate it in thet_pred_mean NOW.
4376 C Now put together the distribution terms to make complete distribution.
4377 termexp=term1+ak*term2
4378 termpre=sigc+ak*sig0i
4379 C Contribution of the bending energy from this theta is just the -log of
4380 C the sum of the contributions from the two lobes and the pre-exponential
4381 C factor. Simple enough, isn't it?
4382 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4383 C NOW the derivatives!!!
4384 C 6/6/97 Take into account the deformation.
4385 E_theta=(delthec*sigcsq*term1
4386 & +ak*delthe0*sig0inv*term2)/termexp
4387 E_tc=((sigtc+aktc*sig0i)/termpre
4388 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4389 & aktc*term2)/termexp)
4392 c-----------------------------------------------------------------------------
4393 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4394 implicit real*8 (a-h,o-z)
4395 include 'DIMENSIONS'
4396 include 'COMMON.LOCAL'
4397 include 'COMMON.IOUNITS'
4398 common /calcthet/ term1,term2,termm,diffak,ratak,
4399 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4400 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4401 delthec=thetai-thet_pred_mean
4402 delthe0=thetai-theta0i
4403 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4404 t3 = thetai-thet_pred_mean
4408 t14 = t12+t6*sigsqtc
4410 t21 = thetai-theta0i
4416 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4417 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4418 & *(-t12*t9-ak*sig0inv*t27)
4422 C--------------------------------------------------------------------------
4423 subroutine ebend(etheta,ethetacnstr)
4425 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4426 C angles gamma and its derivatives in consecutive thetas and gammas.
4427 C ab initio-derived potentials from
4428 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4430 implicit real*8 (a-h,o-z)
4431 include 'DIMENSIONS'
4432 include 'DIMENSIONS.ZSCOPT'
4433 include 'COMMON.LOCAL'
4434 include 'COMMON.GEO'
4435 include 'COMMON.INTERACT'
4436 include 'COMMON.DERIV'
4437 include 'COMMON.VAR'
4438 include 'COMMON.CHAIN'
4439 include 'COMMON.IOUNITS'
4440 include 'COMMON.NAMES'
4441 include 'COMMON.FFIELD'
4442 include 'COMMON.CONTROL'
4443 include 'COMMON.TORCNSTR'
4444 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4445 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4446 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4447 & sinph1ph2(maxdouble,maxdouble)
4448 logical lprn /.false./, lprn1 /.false./
4450 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4451 do i=ithet_start,ithet_end
4453 C if (itype(i-1).eq.ntyp1) cycle
4455 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4456 & .or.itype(i).eq.ntyp1) cycle
4457 if (iabs(itype(i+1)).eq.20) iblock=2
4458 if (iabs(itype(i+1)).ne.20) iblock=1
4462 theti2=0.5d0*theta(i)
4463 ityp2=ithetyp((itype(i-1)))
4465 coskt(k)=dcos(k*theti2)
4466 sinkt(k)=dsin(k*theti2)
4476 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4479 if (phii.ne.phii) phii=150.0
4483 ityp1=ithetyp((itype(i-2)))
4485 cosph1(k)=dcos(k*phii)
4486 sinph1(k)=dsin(k*phii)
4492 ityp1=ithetyp((itype(i-2)))
4498 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4501 if (phii1.ne.phii1) phii1=150.0
4506 ityp3=ithetyp((itype(i)))
4508 cosph2(k)=dcos(k*phii1)
4509 sinph2(k)=dsin(k*phii1)
4514 ityp3=ithetyp((itype(i)))
4520 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4521 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4523 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4526 ccl=cosph1(l)*cosph2(k-l)
4527 ssl=sinph1(l)*sinph2(k-l)
4528 scl=sinph1(l)*cosph2(k-l)
4529 csl=cosph1(l)*sinph2(k-l)
4530 cosph1ph2(l,k)=ccl-ssl
4531 cosph1ph2(k,l)=ccl+ssl
4532 sinph1ph2(l,k)=scl+csl
4533 sinph1ph2(k,l)=scl-csl
4537 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4538 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4539 write (iout,*) "coskt and sinkt"
4541 write (iout,*) k,coskt(k),sinkt(k)
4545 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4546 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4549 & write (iout,*) "k",k,"
4550 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4551 & " ethetai",ethetai
4554 write (iout,*) "cosph and sinph"
4556 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4558 write (iout,*) "cosph1ph2 and sinph2ph2"
4561 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4562 & sinph1ph2(l,k),sinph1ph2(k,l)
4565 write(iout,*) "ethetai",ethetai
4569 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4570 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4571 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4572 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4573 ethetai=ethetai+sinkt(m)*aux
4574 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4575 dephii=dephii+k*sinkt(m)*(
4576 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4577 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4578 dephii1=dephii1+k*sinkt(m)*(
4579 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4580 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4582 & write (iout,*) "m",m," k",k," bbthet",
4583 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4584 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4585 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4586 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4590 & write(iout,*) "ethetai",ethetai
4594 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4595 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4596 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4597 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4598 ethetai=ethetai+sinkt(m)*aux
4599 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4600 dephii=dephii+l*sinkt(m)*(
4601 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4602 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4603 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4604 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4605 dephii1=dephii1+(k-l)*sinkt(m)*(
4606 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4607 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4608 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4609 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4611 write (iout,*) "m",m," k",k," l",l," ffthet",
4612 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4613 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4614 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4615 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4616 & " ethetai",ethetai
4617 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4618 & cosph1ph2(k,l)*sinkt(m),
4619 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4625 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4626 & i,theta(i)*rad2deg,phii*rad2deg,
4627 & phii1*rad2deg,ethetai
4628 etheta=etheta+ethetai
4629 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4630 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4631 c gloc(nphi+i-2,icg)=wang*dethetai
4632 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4636 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4637 do i=1,ntheta_constr
4638 itheta=itheta_constr(i)
4639 thetiii=theta(itheta)
4640 difi=pinorm(thetiii-theta_constr0(i))
4641 if (difi.gt.theta_drange(i)) then
4642 difi=difi-theta_drange(i)
4643 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4644 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4645 & +for_thet_constr(i)*difi**3
4646 else if (difi.lt.-drange(i)) then
4648 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4649 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4650 & +for_thet_constr(i)*difi**3
4654 C if (energy_dec) then
4655 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4656 C & i,itheta,rad2deg*thetiii,
4657 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4658 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4659 C & gloc(itheta+nphi-2,icg)
4666 c-----------------------------------------------------------------------------
4667 subroutine esc(escloc)
4668 C Calculate the local energy of a side chain and its derivatives in the
4669 C corresponding virtual-bond valence angles THETA and the spherical angles
4671 implicit real*8 (a-h,o-z)
4672 include 'DIMENSIONS'
4673 include 'DIMENSIONS.ZSCOPT'
4674 include 'COMMON.GEO'
4675 include 'COMMON.LOCAL'
4676 include 'COMMON.VAR'
4677 include 'COMMON.INTERACT'
4678 include 'COMMON.DERIV'
4679 include 'COMMON.CHAIN'
4680 include 'COMMON.IOUNITS'
4681 include 'COMMON.NAMES'
4682 include 'COMMON.FFIELD'
4683 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4684 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4685 common /sccalc/ time11,time12,time112,theti,it,nlobit
4688 C write (iout,*) 'ESC'
4689 do i=loc_start,loc_end
4691 if (it.eq.ntyp1) cycle
4692 if (it.eq.10) goto 1
4693 nlobit=nlob(iabs(it))
4694 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4695 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4696 theti=theta(i+1)-pipol
4700 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4702 if (x(2).gt.pi-delta) then
4706 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4708 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4709 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4711 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4712 & ddersc0(1),dersc(1))
4713 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4714 & ddersc0(3),dersc(3))
4716 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4718 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4719 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4720 & dersc0(2),esclocbi,dersc02)
4721 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4723 call splinthet(x(2),0.5d0*delta,ss,ssd)
4728 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4730 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4731 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4733 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4735 c write (iout,*) escloci
4736 else if (x(2).lt.delta) then
4740 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4742 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4743 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4745 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4746 & ddersc0(1),dersc(1))
4747 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4748 & ddersc0(3),dersc(3))
4750 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4752 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4753 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4754 & dersc0(2),esclocbi,dersc02)
4755 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4760 call splinthet(x(2),0.5d0*delta,ss,ssd)
4762 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4764 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4765 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4767 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4768 C write (iout,*) 'i=',i, escloci
4770 call enesc(x,escloci,dersc,ddummy,.false.)
4773 escloc=escloc+escloci
4774 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4775 write (iout,'(a6,i5,0pf7.3)')
4776 & 'escloc',i,escloci
4778 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4780 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4781 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4786 C---------------------------------------------------------------------------
4787 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4788 implicit real*8 (a-h,o-z)
4789 include 'DIMENSIONS'
4790 include 'COMMON.GEO'
4791 include 'COMMON.LOCAL'
4792 include 'COMMON.IOUNITS'
4793 common /sccalc/ time11,time12,time112,theti,it,nlobit
4794 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4795 double precision contr(maxlob,-1:1)
4797 c write (iout,*) 'it=',it,' nlobit=',nlobit
4801 if (mixed) ddersc(j)=0.0d0
4805 C Because of periodicity of the dependence of the SC energy in omega we have
4806 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4807 C To avoid underflows, first compute & store the exponents.
4815 z(k)=x(k)-censc(k,j,it)
4820 Axk=Axk+gaussc(l,k,j,it)*z(l)
4826 expfac=expfac+Ax(k,j,iii)*z(k)
4834 C As in the case of ebend, we want to avoid underflows in exponentiation and
4835 C subsequent NaNs and INFs in energy calculation.
4836 C Find the largest exponent
4840 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4844 cd print *,'it=',it,' emin=',emin
4846 C Compute the contribution to SC energy and derivatives
4850 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4851 cd print *,'j=',j,' expfac=',expfac
4852 escloc_i=escloc_i+expfac
4854 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4858 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4859 & +gaussc(k,2,j,it))*expfac
4866 dersc(1)=dersc(1)/cos(theti)**2
4867 ddersc(1)=ddersc(1)/cos(theti)**2
4870 escloci=-(dlog(escloc_i)-emin)
4872 dersc(j)=dersc(j)/escloc_i
4876 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4881 C------------------------------------------------------------------------------
4882 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4883 implicit real*8 (a-h,o-z)
4884 include 'DIMENSIONS'
4885 include 'COMMON.GEO'
4886 include 'COMMON.LOCAL'
4887 include 'COMMON.IOUNITS'
4888 common /sccalc/ time11,time12,time112,theti,it,nlobit
4889 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4890 double precision contr(maxlob)
4901 z(k)=x(k)-censc(k,j,it)
4907 Axk=Axk+gaussc(l,k,j,it)*z(l)
4913 expfac=expfac+Ax(k,j)*z(k)
4918 C As in the case of ebend, we want to avoid underflows in exponentiation and
4919 C subsequent NaNs and INFs in energy calculation.
4920 C Find the largest exponent
4923 if (emin.gt.contr(j)) emin=contr(j)
4927 C Compute the contribution to SC energy and derivatives
4931 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4932 escloc_i=escloc_i+expfac
4934 dersc(k)=dersc(k)+Ax(k,j)*expfac
4936 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4937 & +gaussc(1,2,j,it))*expfac
4941 dersc(1)=dersc(1)/cos(theti)**2
4942 dersc12=dersc12/cos(theti)**2
4943 escloci=-(dlog(escloc_i)-emin)
4945 dersc(j)=dersc(j)/escloc_i
4947 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4951 c----------------------------------------------------------------------------------
4952 subroutine esc(escloc)
4953 C Calculate the local energy of a side chain and its derivatives in the
4954 C corresponding virtual-bond valence angles THETA and the spherical angles
4955 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4956 C added by Urszula Kozlowska. 07/11/2007
4958 implicit real*8 (a-h,o-z)
4959 include 'DIMENSIONS'
4960 include 'DIMENSIONS.ZSCOPT'
4961 include 'COMMON.GEO'
4962 include 'COMMON.LOCAL'
4963 include 'COMMON.VAR'
4964 include 'COMMON.SCROT'
4965 include 'COMMON.INTERACT'
4966 include 'COMMON.DERIV'
4967 include 'COMMON.CHAIN'
4968 include 'COMMON.IOUNITS'
4969 include 'COMMON.NAMES'
4970 include 'COMMON.FFIELD'
4971 include 'COMMON.CONTROL'
4972 include 'COMMON.VECTORS'
4973 double precision x_prime(3),y_prime(3),z_prime(3)
4974 & , sumene,dsc_i,dp2_i,x(65),
4975 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4976 & de_dxx,de_dyy,de_dzz,de_dt
4977 double precision s1_t,s1_6_t,s2_t,s2_6_t
4979 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4980 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4981 & dt_dCi(3),dt_dCi1(3)
4982 common /sccalc/ time11,time12,time112,theti,it,nlobit
4985 do i=loc_start,loc_end
4986 if (itype(i).eq.ntyp1) cycle
4987 costtab(i+1) =dcos(theta(i+1))
4988 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4989 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4990 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4991 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4992 cosfac=dsqrt(cosfac2)
4993 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4994 sinfac=dsqrt(sinfac2)
4996 if (it.eq.10) goto 1
4998 C Compute the axes of tghe local cartesian coordinates system; store in
4999 c x_prime, y_prime and z_prime
5006 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5007 C & dc_norm(3,i+nres)
5009 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5010 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5013 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5016 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5017 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5018 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5019 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5020 c & " xy",scalar(x_prime(1),y_prime(1)),
5021 c & " xz",scalar(x_prime(1),z_prime(1)),
5022 c & " yy",scalar(y_prime(1),y_prime(1)),
5023 c & " yz",scalar(y_prime(1),z_prime(1)),
5024 c & " zz",scalar(z_prime(1),z_prime(1))
5026 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5027 C to local coordinate system. Store in xx, yy, zz.
5033 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5034 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5035 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5042 C Compute the energy of the ith side cbain
5044 c write (2,*) "xx",xx," yy",yy," zz",zz
5047 x(j) = sc_parmin(j,it)
5050 Cc diagnostics - remove later
5052 yy1 = dsin(alph(2))*dcos(omeg(2))
5053 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5054 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5055 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5057 C," --- ", xx_w,yy_w,zz_w
5060 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5061 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5063 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5064 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5066 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5067 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5068 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5069 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5070 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5072 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5073 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5074 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5075 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5076 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5078 dsc_i = 0.743d0+x(61)
5080 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5081 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5082 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5083 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5084 s1=(1+x(63))/(0.1d0 + dscp1)
5085 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5086 s2=(1+x(65))/(0.1d0 + dscp2)
5087 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5088 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5089 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5090 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5092 c & dscp1,dscp2,sumene
5093 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5094 escloc = escloc + sumene
5095 c write (2,*) "escloc",escloc
5096 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5098 if (.not. calc_grad) goto 1
5101 C This section to check the numerical derivatives of the energy of ith side
5102 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5103 C #define DEBUG in the code to turn it on.
5105 write (2,*) "sumene =",sumene
5109 write (2,*) xx,yy,zz
5110 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5111 de_dxx_num=(sumenep-sumene)/aincr
5113 write (2,*) "xx+ sumene from enesc=",sumenep
5116 write (2,*) xx,yy,zz
5117 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5118 de_dyy_num=(sumenep-sumene)/aincr
5120 write (2,*) "yy+ sumene from enesc=",sumenep
5123 write (2,*) xx,yy,zz
5124 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5125 de_dzz_num=(sumenep-sumene)/aincr
5127 write (2,*) "zz+ sumene from enesc=",sumenep
5128 costsave=cost2tab(i+1)
5129 sintsave=sint2tab(i+1)
5130 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5131 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5132 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5133 de_dt_num=(sumenep-sumene)/aincr
5134 write (2,*) " t+ sumene from enesc=",sumenep
5135 cost2tab(i+1)=costsave
5136 sint2tab(i+1)=sintsave
5137 C End of diagnostics section.
5140 C Compute the gradient of esc
5142 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5143 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5144 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5145 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5146 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5147 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5148 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5149 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5150 pom1=(sumene3*sint2tab(i+1)+sumene1)
5151 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5152 pom2=(sumene4*cost2tab(i+1)+sumene2)
5153 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5154 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5155 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5156 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5158 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5159 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5160 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5162 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5163 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5164 & +(pom1+pom2)*pom_dx
5166 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5169 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5170 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5171 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5173 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5174 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5175 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5176 & +x(59)*zz**2 +x(60)*xx*zz
5177 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5178 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5179 & +(pom1-pom2)*pom_dy
5181 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5184 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5185 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5186 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5187 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5188 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5189 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5190 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5191 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5193 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5196 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5197 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5198 & +pom1*pom_dt1+pom2*pom_dt2
5200 write(2,*), "de_dt = ", de_dt,de_dt_num
5204 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5205 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5206 cosfac2xx=cosfac2*xx
5207 sinfac2yy=sinfac2*yy
5209 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5211 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5213 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5214 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5215 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5216 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5217 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5218 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5219 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5220 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5221 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5222 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5226 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5227 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5228 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5229 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5232 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5233 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5234 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5236 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5237 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5241 dXX_Ctab(k,i)=dXX_Ci(k)
5242 dXX_C1tab(k,i)=dXX_Ci1(k)
5243 dYY_Ctab(k,i)=dYY_Ci(k)
5244 dYY_C1tab(k,i)=dYY_Ci1(k)
5245 dZZ_Ctab(k,i)=dZZ_Ci(k)
5246 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5247 dXX_XYZtab(k,i)=dXX_XYZ(k)
5248 dYY_XYZtab(k,i)=dYY_XYZ(k)
5249 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5253 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5254 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5255 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5256 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5257 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5259 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5260 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5261 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5262 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5263 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5264 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5265 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5266 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5268 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5269 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5271 C to check gradient call subroutine check_grad
5278 c------------------------------------------------------------------------------
5279 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5281 C This procedure calculates two-body contact function g(rij) and its derivative:
5284 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5287 C where x=(rij-r0ij)/delta
5289 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5292 double precision rij,r0ij,eps0ij,fcont,fprimcont
5293 double precision x,x2,x4,delta
5297 if (x.lt.-1.0D0) then
5300 else if (x.le.1.0D0) then
5303 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5304 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5311 c------------------------------------------------------------------------------
5312 subroutine splinthet(theti,delta,ss,ssder)
5313 implicit real*8 (a-h,o-z)
5314 include 'DIMENSIONS'
5315 include 'DIMENSIONS.ZSCOPT'
5316 include 'COMMON.VAR'
5317 include 'COMMON.GEO'
5320 if (theti.gt.pipol) then
5321 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5323 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5328 c------------------------------------------------------------------------------
5329 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5331 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5332 double precision ksi,ksi2,ksi3,a1,a2,a3
5333 a1=fprim0*delta/(f1-f0)
5339 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5340 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5343 c------------------------------------------------------------------------------
5344 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5346 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5347 double precision ksi,ksi2,ksi3,a1,a2,a3
5352 a2=3*(f1x-f0x)-2*fprim0x*delta
5353 a3=fprim0x*delta-2*(f1x-f0x)
5354 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5357 C-----------------------------------------------------------------------------
5359 C-----------------------------------------------------------------------------
5360 subroutine etor(etors,edihcnstr,fact)
5361 implicit real*8 (a-h,o-z)
5362 include 'DIMENSIONS'
5363 include 'DIMENSIONS.ZSCOPT'
5364 include 'COMMON.VAR'
5365 include 'COMMON.GEO'
5366 include 'COMMON.LOCAL'
5367 include 'COMMON.TORSION'
5368 include 'COMMON.INTERACT'
5369 include 'COMMON.DERIV'
5370 include 'COMMON.CHAIN'
5371 include 'COMMON.NAMES'
5372 include 'COMMON.IOUNITS'
5373 include 'COMMON.FFIELD'
5374 include 'COMMON.TORCNSTR'
5376 C Set lprn=.true. for debugging
5380 do i=iphi_start,iphi_end
5381 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5382 & .or. itype(i).eq.ntyp1) cycle
5383 itori=itortyp(itype(i-2))
5384 itori1=itortyp(itype(i-1))
5387 C Proline-Proline pair is a special case...
5388 if (itori.eq.3 .and. itori1.eq.3) then
5389 if (phii.gt.-dwapi3) then
5391 fac=1.0D0/(1.0D0-cosphi)
5392 etorsi=v1(1,3,3)*fac
5393 etorsi=etorsi+etorsi
5394 etors=etors+etorsi-v1(1,3,3)
5395 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5398 v1ij=v1(j+1,itori,itori1)
5399 v2ij=v2(j+1,itori,itori1)
5402 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5403 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5407 v1ij=v1(j,itori,itori1)
5408 v2ij=v2(j,itori,itori1)
5411 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5412 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5416 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5417 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5418 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5419 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5420 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5422 ! 6/20/98 - dihedral angle constraints
5425 itori=idih_constr(i)
5428 if (difi.gt.drange(i)) then
5430 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5431 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5432 else if (difi.lt.-drange(i)) then
5434 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5435 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5437 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5438 C & i,itori,rad2deg*phii,
5439 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5441 ! write (iout,*) 'edihcnstr',edihcnstr
5444 c------------------------------------------------------------------------------
5446 subroutine etor(etors,edihcnstr,fact)
5447 implicit real*8 (a-h,o-z)
5448 include 'DIMENSIONS'
5449 include 'DIMENSIONS.ZSCOPT'
5450 include 'COMMON.VAR'
5451 include 'COMMON.GEO'
5452 include 'COMMON.LOCAL'
5453 include 'COMMON.TORSION'
5454 include 'COMMON.INTERACT'
5455 include 'COMMON.DERIV'
5456 include 'COMMON.CHAIN'
5457 include 'COMMON.NAMES'
5458 include 'COMMON.IOUNITS'
5459 include 'COMMON.FFIELD'
5460 include 'COMMON.TORCNSTR'
5462 C Set lprn=.true. for debugging
5466 do i=iphi_start,iphi_end
5468 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5469 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5470 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5471 C & .or. itype(i).eq.ntyp1) cycle
5472 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5473 if (iabs(itype(i)).eq.20) then
5478 itori=itortyp(itype(i-2))
5479 itori1=itortyp(itype(i-1))
5482 C Regular cosine and sine terms
5483 do j=1,nterm(itori,itori1,iblock)
5484 v1ij=v1(j,itori,itori1,iblock)
5485 v2ij=v2(j,itori,itori1,iblock)
5488 etors=etors+v1ij*cosphi+v2ij*sinphi
5489 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5493 C E = SUM ----------------------------------- - v1
5494 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5496 cosphi=dcos(0.5d0*phii)
5497 sinphi=dsin(0.5d0*phii)
5498 do j=1,nlor(itori,itori1,iblock)
5499 vl1ij=vlor1(j,itori,itori1)
5500 vl2ij=vlor2(j,itori,itori1)
5501 vl3ij=vlor3(j,itori,itori1)
5502 pom=vl2ij*cosphi+vl3ij*sinphi
5503 pom1=1.0d0/(pom*pom+1.0d0)
5504 etors=etors+vl1ij*pom1
5505 c if (energy_dec) etors_ii=etors_ii+
5508 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5510 C Subtract the constant term
5511 etors=etors-v0(itori,itori1,iblock)
5513 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5514 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5515 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5516 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5517 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5520 ! 6/20/98 - dihedral angle constraints
5523 itori=idih_constr(i)
5525 difi=pinorm(phii-phi0(i))
5527 if (difi.gt.drange(i)) then
5529 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5530 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5531 edihi=0.25d0*ftors(i)*difi**4
5532 else if (difi.lt.-drange(i)) then
5534 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5535 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5536 edihi=0.25d0*ftors(i)*difi**4
5540 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5541 & i,itori,rad2deg*phii,
5542 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5543 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5545 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5546 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5548 ! write (iout,*) 'edihcnstr',edihcnstr
5551 c----------------------------------------------------------------------------
5552 subroutine etor_d(etors_d,fact2)
5553 C 6/23/01 Compute double torsional energy
5554 implicit real*8 (a-h,o-z)
5555 include 'DIMENSIONS'
5556 include 'DIMENSIONS.ZSCOPT'
5557 include 'COMMON.VAR'
5558 include 'COMMON.GEO'
5559 include 'COMMON.LOCAL'
5560 include 'COMMON.TORSION'
5561 include 'COMMON.INTERACT'
5562 include 'COMMON.DERIV'
5563 include 'COMMON.CHAIN'
5564 include 'COMMON.NAMES'
5565 include 'COMMON.IOUNITS'
5566 include 'COMMON.FFIELD'
5567 include 'COMMON.TORCNSTR'
5569 C Set lprn=.true. for debugging
5573 do i=iphi_start,iphi_end-1
5575 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5576 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5577 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5578 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5579 & (itype(i+1).eq.ntyp1)) cycle
5580 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5582 itori=itortyp(itype(i-2))
5583 itori1=itortyp(itype(i-1))
5584 itori2=itortyp(itype(i))
5590 if (iabs(itype(i+1)).eq.20) iblock=2
5591 C Regular cosine and sine terms
5592 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5593 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5594 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5595 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5596 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5597 cosphi1=dcos(j*phii)
5598 sinphi1=dsin(j*phii)
5599 cosphi2=dcos(j*phii1)
5600 sinphi2=dsin(j*phii1)
5601 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5602 & v2cij*cosphi2+v2sij*sinphi2
5603 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5604 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5606 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5608 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5609 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5610 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5611 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5612 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5613 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5614 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5615 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5616 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5617 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5618 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5619 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5620 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5621 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5624 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5625 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5631 c------------------------------------------------------------------------------
5632 subroutine eback_sc_corr(esccor)
5633 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5634 c conformational states; temporarily implemented as differences
5635 c between UNRES torsional potentials (dependent on three types of
5636 c residues) and the torsional potentials dependent on all 20 types
5637 c of residues computed from AM1 energy surfaces of terminally-blocked
5638 c amino-acid residues.
5639 implicit real*8 (a-h,o-z)
5640 include 'DIMENSIONS'
5641 include 'DIMENSIONS.ZSCOPT'
5642 include 'COMMON.VAR'
5643 include 'COMMON.GEO'
5644 include 'COMMON.LOCAL'
5645 include 'COMMON.TORSION'
5646 include 'COMMON.SCCOR'
5647 include 'COMMON.INTERACT'
5648 include 'COMMON.DERIV'
5649 include 'COMMON.CHAIN'
5650 include 'COMMON.NAMES'
5651 include 'COMMON.IOUNITS'
5652 include 'COMMON.FFIELD'
5653 include 'COMMON.CONTROL'
5655 C Set lprn=.true. for debugging
5658 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5660 do i=itau_start,itau_end
5661 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5663 isccori=isccortyp(itype(i-2))
5664 isccori1=isccortyp(itype(i-1))
5666 do intertyp=1,3 !intertyp
5667 cc Added 09 May 2012 (Adasko)
5668 cc Intertyp means interaction type of backbone mainchain correlation:
5669 c 1 = SC...Ca...Ca...Ca
5670 c 2 = Ca...Ca...Ca...SC
5671 c 3 = SC...Ca...Ca...SCi
5673 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5674 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5675 & (itype(i-1).eq.ntyp1)))
5676 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5677 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5678 & .or.(itype(i).eq.ntyp1)))
5679 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5680 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5681 & (itype(i-3).eq.ntyp1)))) cycle
5682 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5683 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5685 do j=1,nterm_sccor(isccori,isccori1)
5686 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5687 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5688 cosphi=dcos(j*tauangle(intertyp,i))
5689 sinphi=dsin(j*tauangle(intertyp,i))
5690 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5691 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5693 C write (iout,*)"EBACK_SC_COR",esccor,i
5694 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5695 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5696 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5698 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5699 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5700 & (v1sccor(j,1,itori,itori1),j=1,6)
5701 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5702 c gsccor_loc(i-3)=gloci
5707 c------------------------------------------------------------------------------
5708 subroutine multibody(ecorr)
5709 C This subroutine calculates multi-body contributions to energy following
5710 C the idea of Skolnick et al. If side chains I and J make a contact and
5711 C at the same time side chains I+1 and J+1 make a contact, an extra
5712 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5713 implicit real*8 (a-h,o-z)
5714 include 'DIMENSIONS'
5715 include 'COMMON.IOUNITS'
5716 include 'COMMON.DERIV'
5717 include 'COMMON.INTERACT'
5718 include 'COMMON.CONTACTS'
5719 double precision gx(3),gx1(3)
5722 C Set lprn=.true. for debugging
5726 write (iout,'(a)') 'Contact function values:'
5728 write (iout,'(i2,20(1x,i2,f10.5))')
5729 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5744 num_conti=num_cont(i)
5745 num_conti1=num_cont(i1)
5750 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5751 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5752 cd & ' ishift=',ishift
5753 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5754 C The system gains extra energy.
5755 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5756 endif ! j1==j+-ishift
5765 c------------------------------------------------------------------------------
5766 double precision function esccorr(i,j,k,l,jj,kk)
5767 implicit real*8 (a-h,o-z)
5768 include 'DIMENSIONS'
5769 include 'COMMON.IOUNITS'
5770 include 'COMMON.DERIV'
5771 include 'COMMON.INTERACT'
5772 include 'COMMON.CONTACTS'
5773 double precision gx(3),gx1(3)
5778 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5779 C Calculate the multi-body contribution to energy.
5780 C Calculate multi-body contributions to the gradient.
5781 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5782 cd & k,l,(gacont(m,kk,k),m=1,3)
5784 gx(m) =ekl*gacont(m,jj,i)
5785 gx1(m)=eij*gacont(m,kk,k)
5786 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5787 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5788 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5789 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5793 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5798 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5804 c------------------------------------------------------------------------------
5806 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5807 implicit real*8 (a-h,o-z)
5808 include 'DIMENSIONS'
5809 integer dimen1,dimen2,atom,indx
5810 double precision buffer(dimen1,dimen2)
5811 double precision zapas
5812 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5813 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5814 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5815 num_kont=num_cont_hb(atom)
5819 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5822 buffer(i,indx+22)=facont_hb(i,atom)
5823 buffer(i,indx+23)=ees0p(i,atom)
5824 buffer(i,indx+24)=ees0m(i,atom)
5825 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5827 buffer(1,indx+26)=dfloat(num_kont)
5830 c------------------------------------------------------------------------------
5831 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5832 implicit real*8 (a-h,o-z)
5833 include 'DIMENSIONS'
5834 integer dimen1,dimen2,atom,indx
5835 double precision buffer(dimen1,dimen2)
5836 double precision zapas
5837 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5838 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5839 & ees0m(ntyp,maxres),
5840 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5841 num_kont=buffer(1,indx+26)
5842 num_kont_old=num_cont_hb(atom)
5843 num_cont_hb(atom)=num_kont+num_kont_old
5848 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5851 facont_hb(ii,atom)=buffer(i,indx+22)
5852 ees0p(ii,atom)=buffer(i,indx+23)
5853 ees0m(ii,atom)=buffer(i,indx+24)
5854 jcont_hb(ii,atom)=buffer(i,indx+25)
5858 c------------------------------------------------------------------------------
5860 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5861 C This subroutine calculates multi-body contributions to hydrogen-bonding
5862 implicit real*8 (a-h,o-z)
5863 include 'DIMENSIONS'
5864 include 'DIMENSIONS.ZSCOPT'
5865 include 'COMMON.IOUNITS'
5867 include 'COMMON.INFO'
5869 include 'COMMON.FFIELD'
5870 include 'COMMON.DERIV'
5871 include 'COMMON.INTERACT'
5872 include 'COMMON.CONTACTS'
5874 parameter (max_cont=maxconts)
5875 parameter (max_dim=2*(8*3+2))
5876 parameter (msglen1=max_cont*max_dim*4)
5877 parameter (msglen2=2*msglen1)
5878 integer source,CorrelType,CorrelID,Error
5879 double precision buffer(max_cont,max_dim)
5881 double precision gx(3),gx1(3)
5884 C Set lprn=.true. for debugging
5889 if (fgProcs.le.1) goto 30
5891 write (iout,'(a)') 'Contact function values:'
5893 write (iout,'(2i3,50(1x,i2,f5.2))')
5894 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5895 & j=1,num_cont_hb(i))
5898 C Caution! Following code assumes that electrostatic interactions concerning
5899 C a given atom are split among at most two processors!
5909 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5912 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5913 if (MyRank.gt.0) then
5914 C Send correlation contributions to the preceding processor
5916 nn=num_cont_hb(iatel_s)
5917 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5918 cd write (iout,*) 'The BUFFER array:'
5920 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5922 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5924 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5925 C Clear the contacts of the atom passed to the neighboring processor
5926 nn=num_cont_hb(iatel_s+1)
5928 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5930 num_cont_hb(iatel_s)=0
5932 cd write (iout,*) 'Processor ',MyID,MyRank,
5933 cd & ' is sending correlation contribution to processor',MyID-1,
5934 cd & ' msglen=',msglen
5935 cd write (*,*) 'Processor ',MyID,MyRank,
5936 cd & ' is sending correlation contribution to processor',MyID-1,
5937 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5938 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5939 cd write (iout,*) 'Processor ',MyID,
5940 cd & ' has sent correlation contribution to processor',MyID-1,
5941 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5942 cd write (*,*) 'Processor ',MyID,
5943 cd & ' has sent correlation contribution to processor',MyID-1,
5944 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5946 endif ! (MyRank.gt.0)
5950 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5951 if (MyRank.lt.fgProcs-1) then
5952 C Receive correlation contributions from the next processor
5954 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5955 cd write (iout,*) 'Processor',MyID,
5956 cd & ' is receiving correlation contribution from processor',MyID+1,
5957 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5958 cd write (*,*) 'Processor',MyID,
5959 cd & ' is receiving correlation contribution from processor',MyID+1,
5960 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5962 do while (nbytes.le.0)
5963 call mp_probe(MyID+1,CorrelType,nbytes)
5965 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5966 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5967 cd write (iout,*) 'Processor',MyID,
5968 cd & ' has received correlation contribution from processor',MyID+1,
5969 cd & ' msglen=',msglen,' nbytes=',nbytes
5970 cd write (iout,*) 'The received BUFFER array:'
5972 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5974 if (msglen.eq.msglen1) then
5975 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5976 else if (msglen.eq.msglen2) then
5977 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5978 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5981 & 'ERROR!!!! message length changed while processing correlations.'
5983 & 'ERROR!!!! message length changed while processing correlations.'
5984 call mp_stopall(Error)
5985 endif ! msglen.eq.msglen1
5986 endif ! MyRank.lt.fgProcs-1
5993 write (iout,'(a)') 'Contact function values:'
5995 write (iout,'(2i3,50(1x,i2,f5.2))')
5996 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5997 & j=1,num_cont_hb(i))
6001 C Remove the loop below after debugging !!!
6008 C Calculate the local-electrostatic correlation terms
6009 do i=iatel_s,iatel_e+1
6011 num_conti=num_cont_hb(i)
6012 num_conti1=num_cont_hb(i+1)
6017 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6018 c & ' jj=',jj,' kk=',kk
6019 if (j1.eq.j+1 .or. j1.eq.j-1) then
6020 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6021 C The system gains extra energy.
6022 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6024 else if (j1.eq.j) then
6025 C Contacts I-J and I-(J+1) occur simultaneously.
6026 C The system loses extra energy.
6027 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6032 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6033 c & ' jj=',jj,' kk=',kk
6035 C Contacts I-J and (I+1)-J occur simultaneously.
6036 C The system loses extra energy.
6037 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6044 c------------------------------------------------------------------------------
6045 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6047 C This subroutine calculates multi-body contributions to hydrogen-bonding
6048 implicit real*8 (a-h,o-z)
6049 include 'DIMENSIONS'
6050 include 'DIMENSIONS.ZSCOPT'
6051 include 'COMMON.IOUNITS'
6053 include 'COMMON.INFO'
6055 include 'COMMON.FFIELD'
6056 include 'COMMON.DERIV'
6057 include 'COMMON.INTERACT'
6058 include 'COMMON.CONTACTS'
6060 parameter (max_cont=maxconts)
6061 parameter (max_dim=2*(8*3+2))
6062 parameter (msglen1=max_cont*max_dim*4)
6063 parameter (msglen2=2*msglen1)
6064 integer source,CorrelType,CorrelID,Error
6065 double precision buffer(max_cont,max_dim)
6067 double precision gx(3),gx1(3)
6070 C Set lprn=.true. for debugging
6077 if (fgProcs.le.1) goto 30
6079 write (iout,'(a)') 'Contact function values:'
6081 write (iout,'(2i3,50(1x,i2,f5.2))')
6082 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6083 & j=1,num_cont_hb(i))
6086 C Caution! Following code assumes that electrostatic interactions concerning
6087 C a given atom are split among at most two processors!
6097 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6100 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6101 if (MyRank.gt.0) then
6102 C Send correlation contributions to the preceding processor
6104 nn=num_cont_hb(iatel_s)
6105 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6106 cd write (iout,*) 'The BUFFER array:'
6108 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6110 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6112 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6113 C Clear the contacts of the atom passed to the neighboring processor
6114 nn=num_cont_hb(iatel_s+1)
6116 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6118 num_cont_hb(iatel_s)=0
6120 cd write (iout,*) 'Processor ',MyID,MyRank,
6121 cd & ' is sending correlation contribution to processor',MyID-1,
6122 cd & ' msglen=',msglen
6123 cd write (*,*) 'Processor ',MyID,MyRank,
6124 cd & ' is sending correlation contribution to processor',MyID-1,
6125 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6126 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6127 cd write (iout,*) 'Processor ',MyID,
6128 cd & ' has sent correlation contribution to processor',MyID-1,
6129 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6130 cd write (*,*) 'Processor ',MyID,
6131 cd & ' has sent correlation contribution to processor',MyID-1,
6132 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6134 endif ! (MyRank.gt.0)
6138 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6139 if (MyRank.lt.fgProcs-1) then
6140 C Receive correlation contributions from the next processor
6142 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6143 cd write (iout,*) 'Processor',MyID,
6144 cd & ' is receiving correlation contribution from processor',MyID+1,
6145 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6146 cd write (*,*) 'Processor',MyID,
6147 cd & ' is receiving correlation contribution from processor',MyID+1,
6148 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6150 do while (nbytes.le.0)
6151 call mp_probe(MyID+1,CorrelType,nbytes)
6153 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6154 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6155 cd write (iout,*) 'Processor',MyID,
6156 cd & ' has received correlation contribution from processor',MyID+1,
6157 cd & ' msglen=',msglen,' nbytes=',nbytes
6158 cd write (iout,*) 'The received BUFFER array:'
6160 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6162 if (msglen.eq.msglen1) then
6163 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6164 else if (msglen.eq.msglen2) then
6165 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6166 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6169 & 'ERROR!!!! message length changed while processing correlations.'
6171 & 'ERROR!!!! message length changed while processing correlations.'
6172 call mp_stopall(Error)
6173 endif ! msglen.eq.msglen1
6174 endif ! MyRank.lt.fgProcs-1
6181 write (iout,'(a)') 'Contact function values:'
6183 write (iout,'(2i3,50(1x,i2,f5.2))')
6184 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6185 & j=1,num_cont_hb(i))
6191 C Remove the loop below after debugging !!!
6198 C Calculate the dipole-dipole interaction energies
6199 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6200 do i=iatel_s,iatel_e+1
6201 num_conti=num_cont_hb(i)
6208 C Calculate the local-electrostatic correlation terms
6209 do i=iatel_s,iatel_e+1
6211 num_conti=num_cont_hb(i)
6212 num_conti1=num_cont_hb(i+1)
6217 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6218 c & ' jj=',jj,' kk=',kk
6219 if (j1.eq.j+1 .or. j1.eq.j-1) then
6220 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6221 C The system gains extra energy.
6223 sqd1=dsqrt(d_cont(jj,i))
6224 sqd2=dsqrt(d_cont(kk,i1))
6225 sred_geom = sqd1*sqd2
6226 IF (sred_geom.lt.cutoff_corr) THEN
6227 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6229 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6230 c & ' jj=',jj,' kk=',kk
6231 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6232 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6234 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6235 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6238 cd write (iout,*) 'sred_geom=',sred_geom,
6239 cd & ' ekont=',ekont,' fprim=',fprimcont
6240 call calc_eello(i,j,i+1,j1,jj,kk)
6241 if (wcorr4.gt.0.0d0)
6242 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6243 if (wcorr5.gt.0.0d0)
6244 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6245 c print *,"wcorr5",ecorr5
6246 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6247 cd write(2,*)'ijkl',i,j,i+1,j1
6248 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6249 & .or. wturn6.eq.0.0d0))then
6250 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6251 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6252 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6253 cd & 'ecorr6=',ecorr6
6254 cd write (iout,'(4e15.5)') sred_geom,
6255 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6256 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6257 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6258 else if (wturn6.gt.0.0d0
6259 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6260 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6261 eturn6=eturn6+eello_turn6(i,jj,kk)
6262 cd write (2,*) 'multibody_eello:eturn6',eturn6
6263 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6270 else if (j1.eq.j) then
6271 C Contacts I-J and I-(J+1) occur simultaneously.
6272 C The system loses extra energy.
6273 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6278 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6279 c & ' jj=',jj,' kk=',kk
6281 C Contacts I-J and (I+1)-J occur simultaneously.
6282 C The system loses extra energy.
6283 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6288 write (iout,*) "eturn6",eturn6,ecorr6
6291 c------------------------------------------------------------------------------
6292 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6293 implicit real*8 (a-h,o-z)
6294 include 'DIMENSIONS'
6295 include 'COMMON.IOUNITS'
6296 include 'COMMON.DERIV'
6297 include 'COMMON.INTERACT'
6298 include 'COMMON.CONTACTS'
6299 include 'COMMON.CONTROL'
6300 include 'COMMON.SHIELD'
6301 double precision gx(3),gx1(3)
6311 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6312 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6313 C Following 4 lines for diagnostics.
6318 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6320 c write (iout,*)'Contacts have occurred for peptide groups',
6321 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6322 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6323 C Calculate the multi-body contribution to energy.
6324 C ecorr=ecorr+ekont*ees
6326 C Calculate multi-body contributions to the gradient.
6328 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6329 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6330 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6331 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6332 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6333 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6334 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6335 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6336 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6337 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6338 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6339 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6340 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6341 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6345 gradcorr(ll,m)=gradcorr(ll,m)+
6346 & ees*ekl*gacont_hbr(ll,jj,i)-
6347 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6348 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6353 gradcorr(ll,m)=gradcorr(ll,m)+
6354 & ees*eij*gacont_hbr(ll,kk,k)-
6355 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6356 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6359 if (shield_mode.gt.0) then
6362 C print *,i,j,fac_shield(i),fac_shield(j),
6363 C &fac_shield(k),fac_shield(l)
6364 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6365 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6366 do ilist=1,ishield_list(i)
6367 iresshield=shield_list(ilist,i)
6369 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6371 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6373 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6374 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6378 do ilist=1,ishield_list(j)
6379 iresshield=shield_list(ilist,j)
6381 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6383 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6385 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6386 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6390 do ilist=1,ishield_list(k)
6391 iresshield=shield_list(ilist,k)
6393 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6395 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6397 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6398 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6402 do ilist=1,ishield_list(l)
6403 iresshield=shield_list(ilist,l)
6405 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6407 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6409 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6410 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6414 C print *,gshieldx(m,iresshield)
6416 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6417 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6418 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6419 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6420 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6421 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6422 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6423 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6425 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6426 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6427 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6428 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6429 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6430 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6431 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6432 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6441 C---------------------------------------------------------------------------
6442 subroutine dipole(i,j,jj)
6443 implicit real*8 (a-h,o-z)
6444 include 'DIMENSIONS'
6445 include 'DIMENSIONS.ZSCOPT'
6446 include 'COMMON.IOUNITS'
6447 include 'COMMON.CHAIN'
6448 include 'COMMON.FFIELD'
6449 include 'COMMON.DERIV'
6450 include 'COMMON.INTERACT'
6451 include 'COMMON.CONTACTS'
6452 include 'COMMON.TORSION'
6453 include 'COMMON.VAR'
6454 include 'COMMON.GEO'
6455 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6457 iti1 = itortyp(itype(i+1))
6458 if (j.lt.nres-1) then
6459 if (itype(j).le.ntyp) then
6460 itj1 = itortyp(itype(j+1))
6468 dipi(iii,1)=Ub2(iii,i)
6469 dipderi(iii)=Ub2der(iii,i)
6470 dipi(iii,2)=b1(iii,iti1)
6471 dipj(iii,1)=Ub2(iii,j)
6472 dipderj(iii)=Ub2der(iii,j)
6473 dipj(iii,2)=b1(iii,itj1)
6477 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6480 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6483 if (.not.calc_grad) return
6488 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6492 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6497 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6498 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6500 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6502 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6504 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6508 C---------------------------------------------------------------------------
6509 subroutine calc_eello(i,j,k,l,jj,kk)
6511 C This subroutine computes matrices and vectors needed to calculate
6512 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6514 implicit real*8 (a-h,o-z)
6515 include 'DIMENSIONS'
6516 include 'DIMENSIONS.ZSCOPT'
6517 include 'COMMON.IOUNITS'
6518 include 'COMMON.CHAIN'
6519 include 'COMMON.DERIV'
6520 include 'COMMON.INTERACT'
6521 include 'COMMON.CONTACTS'
6522 include 'COMMON.TORSION'
6523 include 'COMMON.VAR'
6524 include 'COMMON.GEO'
6525 include 'COMMON.FFIELD'
6526 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6527 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6530 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6531 cd & ' jj=',jj,' kk=',kk
6532 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6535 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6536 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6539 call transpose2(aa1(1,1),aa1t(1,1))
6540 call transpose2(aa2(1,1),aa2t(1,1))
6543 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6544 & aa1tder(1,1,lll,kkk))
6545 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6546 & aa2tder(1,1,lll,kkk))
6550 C parallel orientation of the two CA-CA-CA frames.
6551 if (i.gt.1 .and. itype(i).le.ntyp) then
6552 iti=itortyp(itype(i))
6556 itk1=itortyp(itype(k+1))
6557 itj=itortyp(itype(j))
6558 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6559 itl1=itortyp(itype(l+1))
6563 C A1 kernel(j+1) A2T
6565 cd write (iout,'(3f10.5,5x,3f10.5)')
6566 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6568 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6569 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6570 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6571 C Following matrices are needed only for 6-th order cumulants
6572 IF (wcorr6.gt.0.0d0) THEN
6573 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6574 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6575 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6576 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6577 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6578 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6579 & ADtEAderx(1,1,1,1,1,1))
6581 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6582 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6583 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6584 & ADtEA1derx(1,1,1,1,1,1))
6586 C End 6-th order cumulants
6589 cd write (2,*) 'In calc_eello6'
6591 cd write (2,*) 'iii=',iii
6593 cd write (2,*) 'kkk=',kkk
6595 cd write (2,'(3(2f10.5),5x)')
6596 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6601 call transpose2(EUgder(1,1,k),auxmat(1,1))
6602 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6603 call transpose2(EUg(1,1,k),auxmat(1,1))
6604 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6605 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6609 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6610 & EAEAderx(1,1,lll,kkk,iii,1))
6614 C A1T kernel(i+1) A2
6615 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6616 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6617 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6618 C Following matrices are needed only for 6-th order cumulants
6619 IF (wcorr6.gt.0.0d0) THEN
6620 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6621 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6622 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6623 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6624 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6625 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6626 & ADtEAderx(1,1,1,1,1,2))
6627 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6628 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6629 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6630 & ADtEA1derx(1,1,1,1,1,2))
6632 C End 6-th order cumulants
6633 call transpose2(EUgder(1,1,l),auxmat(1,1))
6634 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6635 call transpose2(EUg(1,1,l),auxmat(1,1))
6636 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6637 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6641 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6642 & EAEAderx(1,1,lll,kkk,iii,2))
6647 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6648 C They are needed only when the fifth- or the sixth-order cumulants are
6650 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6651 call transpose2(AEA(1,1,1),auxmat(1,1))
6652 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6653 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6654 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6655 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6656 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6657 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6658 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6659 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6660 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6661 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6662 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6663 call transpose2(AEA(1,1,2),auxmat(1,1))
6664 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6665 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6666 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6667 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6668 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6669 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6670 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6671 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6672 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6673 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6674 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6675 C Calculate the Cartesian derivatives of the vectors.
6679 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6680 call matvec2(auxmat(1,1),b1(1,iti),
6681 & AEAb1derx(1,lll,kkk,iii,1,1))
6682 call matvec2(auxmat(1,1),Ub2(1,i),
6683 & AEAb2derx(1,lll,kkk,iii,1,1))
6684 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6685 & AEAb1derx(1,lll,kkk,iii,2,1))
6686 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6687 & AEAb2derx(1,lll,kkk,iii,2,1))
6688 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6689 call matvec2(auxmat(1,1),b1(1,itj),
6690 & AEAb1derx(1,lll,kkk,iii,1,2))
6691 call matvec2(auxmat(1,1),Ub2(1,j),
6692 & AEAb2derx(1,lll,kkk,iii,1,2))
6693 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6694 & AEAb1derx(1,lll,kkk,iii,2,2))
6695 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6696 & AEAb2derx(1,lll,kkk,iii,2,2))
6703 C Antiparallel orientation of the two CA-CA-CA frames.
6704 if (i.gt.1 .and. itype(i).le.ntyp) then
6705 iti=itortyp(itype(i))
6709 itk1=itortyp(itype(k+1))
6710 itl=itortyp(itype(l))
6711 itj=itortyp(itype(j))
6712 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6713 itj1=itortyp(itype(j+1))
6717 C A2 kernel(j-1)T A1T
6718 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6719 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6720 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6721 C Following matrices are needed only for 6-th order cumulants
6722 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6723 & j.eq.i+4 .and. l.eq.i+3)) THEN
6724 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6725 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6726 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6727 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6728 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6729 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6730 & ADtEAderx(1,1,1,1,1,1))
6731 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6732 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6733 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6734 & ADtEA1derx(1,1,1,1,1,1))
6736 C End 6-th order cumulants
6737 call transpose2(EUgder(1,1,k),auxmat(1,1))
6738 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6739 call transpose2(EUg(1,1,k),auxmat(1,1))
6740 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6741 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6745 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6746 & EAEAderx(1,1,lll,kkk,iii,1))
6750 C A2T kernel(i+1)T A1
6751 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6752 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6753 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6754 C Following matrices are needed only for 6-th order cumulants
6755 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6756 & j.eq.i+4 .and. l.eq.i+3)) THEN
6757 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6758 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6759 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6760 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6761 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6762 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6763 & ADtEAderx(1,1,1,1,1,2))
6764 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6765 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6766 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6767 & ADtEA1derx(1,1,1,1,1,2))
6769 C End 6-th order cumulants
6770 call transpose2(EUgder(1,1,j),auxmat(1,1))
6771 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6772 call transpose2(EUg(1,1,j),auxmat(1,1))
6773 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6774 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6778 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6779 & EAEAderx(1,1,lll,kkk,iii,2))
6784 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6785 C They are needed only when the fifth- or the sixth-order cumulants are
6787 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6788 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6789 call transpose2(AEA(1,1,1),auxmat(1,1))
6790 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6791 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6792 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6793 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6794 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6795 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6796 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6797 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6798 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6799 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6800 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6801 call transpose2(AEA(1,1,2),auxmat(1,1))
6802 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6803 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6804 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6805 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6806 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6807 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6808 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6809 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6810 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6811 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6812 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6813 C Calculate the Cartesian derivatives of the vectors.
6817 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6818 call matvec2(auxmat(1,1),b1(1,iti),
6819 & AEAb1derx(1,lll,kkk,iii,1,1))
6820 call matvec2(auxmat(1,1),Ub2(1,i),
6821 & AEAb2derx(1,lll,kkk,iii,1,1))
6822 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6823 & AEAb1derx(1,lll,kkk,iii,2,1))
6824 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6825 & AEAb2derx(1,lll,kkk,iii,2,1))
6826 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6827 call matvec2(auxmat(1,1),b1(1,itl),
6828 & AEAb1derx(1,lll,kkk,iii,1,2))
6829 call matvec2(auxmat(1,1),Ub2(1,l),
6830 & AEAb2derx(1,lll,kkk,iii,1,2))
6831 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6832 & AEAb1derx(1,lll,kkk,iii,2,2))
6833 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6834 & AEAb2derx(1,lll,kkk,iii,2,2))
6843 C---------------------------------------------------------------------------
6844 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6845 & KK,KKderg,AKA,AKAderg,AKAderx)
6849 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6850 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6851 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6856 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6858 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6861 cd if (lprn) write (2,*) 'In kernel'
6863 cd if (lprn) write (2,*) 'kkk=',kkk
6865 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6866 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6868 cd write (2,*) 'lll=',lll
6869 cd write (2,*) 'iii=1'
6871 cd write (2,'(3(2f10.5),5x)')
6872 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6875 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6876 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6878 cd write (2,*) 'lll=',lll
6879 cd write (2,*) 'iii=2'
6881 cd write (2,'(3(2f10.5),5x)')
6882 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6889 C---------------------------------------------------------------------------
6890 double precision function eello4(i,j,k,l,jj,kk)
6891 implicit real*8 (a-h,o-z)
6892 include 'DIMENSIONS'
6893 include 'DIMENSIONS.ZSCOPT'
6894 include 'COMMON.IOUNITS'
6895 include 'COMMON.CHAIN'
6896 include 'COMMON.DERIV'
6897 include 'COMMON.INTERACT'
6898 include 'COMMON.CONTACTS'
6899 include 'COMMON.TORSION'
6900 include 'COMMON.VAR'
6901 include 'COMMON.GEO'
6902 double precision pizda(2,2),ggg1(3),ggg2(3)
6903 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6907 cd print *,'eello4:',i,j,k,l,jj,kk
6908 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6909 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6910 cold eij=facont_hb(jj,i)
6911 cold ekl=facont_hb(kk,k)
6913 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6915 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6916 gcorr_loc(k-1)=gcorr_loc(k-1)
6917 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6919 gcorr_loc(l-1)=gcorr_loc(l-1)
6920 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6922 gcorr_loc(j-1)=gcorr_loc(j-1)
6923 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6928 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6929 & -EAEAderx(2,2,lll,kkk,iii,1)
6930 cd derx(lll,kkk,iii)=0.0d0
6934 cd gcorr_loc(l-1)=0.0d0
6935 cd gcorr_loc(j-1)=0.0d0
6936 cd gcorr_loc(k-1)=0.0d0
6938 cd write (iout,*)'Contacts have occurred for peptide groups',
6939 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6940 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6941 if (j.lt.nres-1) then
6948 if (l.lt.nres-1) then
6956 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6957 ggg1(ll)=eel4*g_contij(ll,1)
6958 ggg2(ll)=eel4*g_contij(ll,2)
6959 ghalf=0.5d0*ggg1(ll)
6961 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6962 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6963 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6964 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6965 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6966 ghalf=0.5d0*ggg2(ll)
6968 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6969 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6970 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6971 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6976 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6977 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6982 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6983 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6989 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6994 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6998 cd write (2,*) iii,gcorr_loc(iii)
7002 cd write (2,*) 'ekont',ekont
7003 cd write (iout,*) 'eello4',ekont*eel4
7006 C---------------------------------------------------------------------------
7007 double precision function eello5(i,j,k,l,jj,kk)
7008 implicit real*8 (a-h,o-z)
7009 include 'DIMENSIONS'
7010 include 'DIMENSIONS.ZSCOPT'
7011 include 'COMMON.IOUNITS'
7012 include 'COMMON.CHAIN'
7013 include 'COMMON.DERIV'
7014 include 'COMMON.INTERACT'
7015 include 'COMMON.CONTACTS'
7016 include 'COMMON.TORSION'
7017 include 'COMMON.VAR'
7018 include 'COMMON.GEO'
7019 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7020 double precision ggg1(3),ggg2(3)
7021 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7026 C /l\ / \ \ / \ / \ / C
7027 C / \ / \ \ / \ / \ / C
7028 C j| o |l1 | o | o| o | | o |o C
7029 C \ |/k\| |/ \| / |/ \| |/ \| C
7030 C \i/ \ / \ / / \ / \ C
7032 C (I) (II) (III) (IV) C
7034 C eello5_1 eello5_2 eello5_3 eello5_4 C
7036 C Antiparallel chains C
7039 C /j\ / \ \ / \ / \ / C
7040 C / \ / \ \ / \ / \ / C
7041 C j1| o |l | o | o| o | | o |o C
7042 C \ |/k\| |/ \| / |/ \| |/ \| C
7043 C \i/ \ / \ / / \ / \ C
7045 C (I) (II) (III) (IV) C
7047 C eello5_1 eello5_2 eello5_3 eello5_4 C
7049 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7051 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7052 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7057 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7059 itk=itortyp(itype(k))
7060 itl=itortyp(itype(l))
7061 itj=itortyp(itype(j))
7066 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7067 cd & eel5_3_num,eel5_4_num)
7071 derx(lll,kkk,iii)=0.0d0
7075 cd eij=facont_hb(jj,i)
7076 cd ekl=facont_hb(kk,k)
7078 cd write (iout,*)'Contacts have occurred for peptide groups',
7079 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7081 C Contribution from the graph I.
7082 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7083 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7084 call transpose2(EUg(1,1,k),auxmat(1,1))
7085 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7086 vv(1)=pizda(1,1)-pizda(2,2)
7087 vv(2)=pizda(1,2)+pizda(2,1)
7088 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7089 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7091 C Explicit gradient in virtual-dihedral angles.
7092 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7093 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7094 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7095 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7096 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7097 vv(1)=pizda(1,1)-pizda(2,2)
7098 vv(2)=pizda(1,2)+pizda(2,1)
7099 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7100 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7101 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7102 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7103 vv(1)=pizda(1,1)-pizda(2,2)
7104 vv(2)=pizda(1,2)+pizda(2,1)
7106 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7107 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7108 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7110 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7111 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7112 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7114 C Cartesian gradient
7118 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7120 vv(1)=pizda(1,1)-pizda(2,2)
7121 vv(2)=pizda(1,2)+pizda(2,1)
7122 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7123 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7124 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7131 C Contribution from graph II
7132 call transpose2(EE(1,1,itk),auxmat(1,1))
7133 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7134 vv(1)=pizda(1,1)+pizda(2,2)
7135 vv(2)=pizda(2,1)-pizda(1,2)
7136 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7137 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7139 C Explicit gradient in virtual-dihedral angles.
7140 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7141 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7142 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7143 vv(1)=pizda(1,1)+pizda(2,2)
7144 vv(2)=pizda(2,1)-pizda(1,2)
7146 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7147 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7148 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7150 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7151 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7152 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7154 C Cartesian gradient
7158 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7160 vv(1)=pizda(1,1)+pizda(2,2)
7161 vv(2)=pizda(2,1)-pizda(1,2)
7162 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7163 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7164 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7173 C Parallel orientation
7174 C Contribution from graph III
7175 call transpose2(EUg(1,1,l),auxmat(1,1))
7176 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7177 vv(1)=pizda(1,1)-pizda(2,2)
7178 vv(2)=pizda(1,2)+pizda(2,1)
7179 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7180 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7182 C Explicit gradient in virtual-dihedral angles.
7183 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7184 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7185 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7186 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7187 vv(1)=pizda(1,1)-pizda(2,2)
7188 vv(2)=pizda(1,2)+pizda(2,1)
7189 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7190 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7191 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7192 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7193 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7194 vv(1)=pizda(1,1)-pizda(2,2)
7195 vv(2)=pizda(1,2)+pizda(2,1)
7196 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7197 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7198 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7199 C Cartesian gradient
7203 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7205 vv(1)=pizda(1,1)-pizda(2,2)
7206 vv(2)=pizda(1,2)+pizda(2,1)
7207 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7208 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7209 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7215 C Contribution from graph IV
7217 call transpose2(EE(1,1,itl),auxmat(1,1))
7218 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7219 vv(1)=pizda(1,1)+pizda(2,2)
7220 vv(2)=pizda(2,1)-pizda(1,2)
7221 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7222 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7224 C Explicit gradient in virtual-dihedral angles.
7225 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7226 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7227 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7228 vv(1)=pizda(1,1)+pizda(2,2)
7229 vv(2)=pizda(2,1)-pizda(1,2)
7230 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7231 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7232 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7233 C Cartesian gradient
7237 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7239 vv(1)=pizda(1,1)+pizda(2,2)
7240 vv(2)=pizda(2,1)-pizda(1,2)
7241 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7242 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7243 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7249 C Antiparallel orientation
7250 C Contribution from graph III
7252 call transpose2(EUg(1,1,j),auxmat(1,1))
7253 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7254 vv(1)=pizda(1,1)-pizda(2,2)
7255 vv(2)=pizda(1,2)+pizda(2,1)
7256 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7257 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7259 C Explicit gradient in virtual-dihedral angles.
7260 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7261 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7262 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7263 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7264 vv(1)=pizda(1,1)-pizda(2,2)
7265 vv(2)=pizda(1,2)+pizda(2,1)
7266 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7267 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7268 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7269 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7270 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7271 vv(1)=pizda(1,1)-pizda(2,2)
7272 vv(2)=pizda(1,2)+pizda(2,1)
7273 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7274 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7275 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7276 C Cartesian gradient
7280 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7282 vv(1)=pizda(1,1)-pizda(2,2)
7283 vv(2)=pizda(1,2)+pizda(2,1)
7284 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7285 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7286 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7292 C Contribution from graph IV
7294 call transpose2(EE(1,1,itj),auxmat(1,1))
7295 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7296 vv(1)=pizda(1,1)+pizda(2,2)
7297 vv(2)=pizda(2,1)-pizda(1,2)
7298 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7299 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7301 C Explicit gradient in virtual-dihedral angles.
7302 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7303 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7304 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7305 vv(1)=pizda(1,1)+pizda(2,2)
7306 vv(2)=pizda(2,1)-pizda(1,2)
7307 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7308 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7309 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7310 C Cartesian gradient
7314 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7316 vv(1)=pizda(1,1)+pizda(2,2)
7317 vv(2)=pizda(2,1)-pizda(1,2)
7318 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7319 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7320 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7327 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7328 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7329 cd write (2,*) 'ijkl',i,j,k,l
7330 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7331 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7333 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7334 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7335 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7336 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7338 if (j.lt.nres-1) then
7345 if (l.lt.nres-1) then
7355 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7357 ggg1(ll)=eel5*g_contij(ll,1)
7358 ggg2(ll)=eel5*g_contij(ll,2)
7359 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7360 ghalf=0.5d0*ggg1(ll)
7362 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7363 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7364 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7365 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7366 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7367 ghalf=0.5d0*ggg2(ll)
7369 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7370 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7371 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7372 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7377 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7378 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7383 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7384 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7390 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7395 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7399 cd write (2,*) iii,g_corr5_loc(iii)
7403 cd write (2,*) 'ekont',ekont
7404 cd write (iout,*) 'eello5',ekont*eel5
7407 c--------------------------------------------------------------------------
7408 double precision function eello6(i,j,k,l,jj,kk)
7409 implicit real*8 (a-h,o-z)
7410 include 'DIMENSIONS'
7411 include 'DIMENSIONS.ZSCOPT'
7412 include 'COMMON.IOUNITS'
7413 include 'COMMON.CHAIN'
7414 include 'COMMON.DERIV'
7415 include 'COMMON.INTERACT'
7416 include 'COMMON.CONTACTS'
7417 include 'COMMON.TORSION'
7418 include 'COMMON.VAR'
7419 include 'COMMON.GEO'
7420 include 'COMMON.FFIELD'
7421 double precision ggg1(3),ggg2(3)
7422 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7427 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7435 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7436 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7440 derx(lll,kkk,iii)=0.0d0
7444 cd eij=facont_hb(jj,i)
7445 cd ekl=facont_hb(kk,k)
7451 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7452 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7453 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7454 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7455 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7456 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7458 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7459 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7460 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7461 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7462 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7463 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7467 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7469 C If turn contributions are considered, they will be handled separately.
7470 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7471 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7472 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7473 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7474 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7475 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7476 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7479 if (j.lt.nres-1) then
7486 if (l.lt.nres-1) then
7494 ggg1(ll)=eel6*g_contij(ll,1)
7495 ggg2(ll)=eel6*g_contij(ll,2)
7496 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7497 ghalf=0.5d0*ggg1(ll)
7499 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7500 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7501 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7502 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7503 ghalf=0.5d0*ggg2(ll)
7504 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7506 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7507 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7508 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7509 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7514 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7515 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7520 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7521 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7527 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7532 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7536 cd write (2,*) iii,g_corr6_loc(iii)
7540 cd write (2,*) 'ekont',ekont
7541 cd write (iout,*) 'eello6',ekont*eel6
7544 c--------------------------------------------------------------------------
7545 double precision function eello6_graph1(i,j,k,l,imat,swap)
7546 implicit real*8 (a-h,o-z)
7547 include 'DIMENSIONS'
7548 include 'DIMENSIONS.ZSCOPT'
7549 include 'COMMON.IOUNITS'
7550 include 'COMMON.CHAIN'
7551 include 'COMMON.DERIV'
7552 include 'COMMON.INTERACT'
7553 include 'COMMON.CONTACTS'
7554 include 'COMMON.TORSION'
7555 include 'COMMON.VAR'
7556 include 'COMMON.GEO'
7557 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7561 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7563 C Parallel Antiparallel C
7569 C \ j|/k\| / \ |/k\|l / C
7574 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7575 itk=itortyp(itype(k))
7576 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7577 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7578 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7579 call transpose2(EUgC(1,1,k),auxmat(1,1))
7580 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7581 vv1(1)=pizda1(1,1)-pizda1(2,2)
7582 vv1(2)=pizda1(1,2)+pizda1(2,1)
7583 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7584 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7585 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7586 s5=scalar2(vv(1),Dtobr2(1,i))
7587 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7588 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7589 if (.not. calc_grad) return
7590 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7591 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7592 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7593 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7594 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7595 & +scalar2(vv(1),Dtobr2der(1,i)))
7596 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7597 vv1(1)=pizda1(1,1)-pizda1(2,2)
7598 vv1(2)=pizda1(1,2)+pizda1(2,1)
7599 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7600 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7602 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7603 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7604 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7605 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7606 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7608 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7609 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7610 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7611 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7612 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7614 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7615 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7616 vv1(1)=pizda1(1,1)-pizda1(2,2)
7617 vv1(2)=pizda1(1,2)+pizda1(2,1)
7618 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7619 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7620 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7621 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7630 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7631 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7632 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7633 call transpose2(EUgC(1,1,k),auxmat(1,1))
7634 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7636 vv1(1)=pizda1(1,1)-pizda1(2,2)
7637 vv1(2)=pizda1(1,2)+pizda1(2,1)
7638 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7639 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7640 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7641 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7642 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7643 s5=scalar2(vv(1),Dtobr2(1,i))
7644 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7650 c----------------------------------------------------------------------------
7651 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7652 implicit real*8 (a-h,o-z)
7653 include 'DIMENSIONS'
7654 include 'DIMENSIONS.ZSCOPT'
7655 include 'COMMON.IOUNITS'
7656 include 'COMMON.CHAIN'
7657 include 'COMMON.DERIV'
7658 include 'COMMON.INTERACT'
7659 include 'COMMON.CONTACTS'
7660 include 'COMMON.TORSION'
7661 include 'COMMON.VAR'
7662 include 'COMMON.GEO'
7664 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7665 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7668 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7670 C Parallel Antiparallel C
7676 C \ j|/k\| \ |/k\|l C
7681 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7682 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7683 C AL 7/4/01 s1 would occur in the sixth-order moment,
7684 C but not in a cluster cumulant
7686 s1=dip(1,jj,i)*dip(1,kk,k)
7688 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7689 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7690 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7691 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7692 call transpose2(EUg(1,1,k),auxmat(1,1))
7693 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7694 vv(1)=pizda(1,1)-pizda(2,2)
7695 vv(2)=pizda(1,2)+pizda(2,1)
7696 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7697 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7699 eello6_graph2=-(s1+s2+s3+s4)
7701 eello6_graph2=-(s2+s3+s4)
7704 if (.not. calc_grad) return
7705 C Derivatives in gamma(i-1)
7708 s1=dipderg(1,jj,i)*dip(1,kk,k)
7710 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7711 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7712 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7713 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7715 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7717 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7719 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7721 C Derivatives in gamma(k-1)
7723 s1=dip(1,jj,i)*dipderg(1,kk,k)
7725 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7726 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7727 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7728 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7729 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7730 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7731 vv(1)=pizda(1,1)-pizda(2,2)
7732 vv(2)=pizda(1,2)+pizda(2,1)
7733 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7735 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7737 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7739 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7740 C Derivatives in gamma(j-1) or gamma(l-1)
7743 s1=dipderg(3,jj,i)*dip(1,kk,k)
7745 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7746 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7747 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7748 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7749 vv(1)=pizda(1,1)-pizda(2,2)
7750 vv(2)=pizda(1,2)+pizda(2,1)
7751 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7754 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7756 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7759 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7760 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7762 C Derivatives in gamma(l-1) or gamma(j-1)
7765 s1=dip(1,jj,i)*dipderg(3,kk,k)
7767 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7768 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7769 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7770 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7771 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7772 vv(1)=pizda(1,1)-pizda(2,2)
7773 vv(2)=pizda(1,2)+pizda(2,1)
7774 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7777 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7779 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7782 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7783 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7785 C Cartesian derivatives.
7787 write (2,*) 'In eello6_graph2'
7789 write (2,*) 'iii=',iii
7791 write (2,*) 'kkk=',kkk
7793 write (2,'(3(2f10.5),5x)')
7794 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7804 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7806 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7809 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7811 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7812 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7814 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7815 call transpose2(EUg(1,1,k),auxmat(1,1))
7816 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7818 vv(1)=pizda(1,1)-pizda(2,2)
7819 vv(2)=pizda(1,2)+pizda(2,1)
7820 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7821 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7823 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7825 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7828 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7830 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7837 c----------------------------------------------------------------------------
7838 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7839 implicit real*8 (a-h,o-z)
7840 include 'DIMENSIONS'
7841 include 'DIMENSIONS.ZSCOPT'
7842 include 'COMMON.IOUNITS'
7843 include 'COMMON.CHAIN'
7844 include 'COMMON.DERIV'
7845 include 'COMMON.INTERACT'
7846 include 'COMMON.CONTACTS'
7847 include 'COMMON.TORSION'
7848 include 'COMMON.VAR'
7849 include 'COMMON.GEO'
7850 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7852 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7854 C Parallel Antiparallel C
7860 C j|/k\| / |/k\|l / C
7865 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7867 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7868 C energy moment and not to the cluster cumulant.
7869 iti=itortyp(itype(i))
7870 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7871 itj1=itortyp(itype(j+1))
7875 itk=itortyp(itype(k))
7876 itk1=itortyp(itype(k+1))
7877 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7878 itl1=itortyp(itype(l+1))
7883 s1=dip(4,jj,i)*dip(4,kk,k)
7885 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7886 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7887 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7888 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7889 call transpose2(EE(1,1,itk),auxmat(1,1))
7890 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7891 vv(1)=pizda(1,1)+pizda(2,2)
7892 vv(2)=pizda(2,1)-pizda(1,2)
7893 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7894 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7896 eello6_graph3=-(s1+s2+s3+s4)
7898 eello6_graph3=-(s2+s3+s4)
7901 if (.not. calc_grad) return
7902 C Derivatives in gamma(k-1)
7903 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7904 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7905 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7906 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7907 C Derivatives in gamma(l-1)
7908 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7909 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7910 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7911 vv(1)=pizda(1,1)+pizda(2,2)
7912 vv(2)=pizda(2,1)-pizda(1,2)
7913 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7914 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7915 C Cartesian derivatives.
7921 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7923 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7926 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7928 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7929 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7931 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7932 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7934 vv(1)=pizda(1,1)+pizda(2,2)
7935 vv(2)=pizda(2,1)-pizda(1,2)
7936 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7938 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7940 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7943 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7945 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7947 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7953 c----------------------------------------------------------------------------
7954 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7955 implicit real*8 (a-h,o-z)
7956 include 'DIMENSIONS'
7957 include 'DIMENSIONS.ZSCOPT'
7958 include 'COMMON.IOUNITS'
7959 include 'COMMON.CHAIN'
7960 include 'COMMON.DERIV'
7961 include 'COMMON.INTERACT'
7962 include 'COMMON.CONTACTS'
7963 include 'COMMON.TORSION'
7964 include 'COMMON.VAR'
7965 include 'COMMON.GEO'
7966 include 'COMMON.FFIELD'
7967 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7968 & auxvec1(2),auxmat1(2,2)
7970 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7972 C Parallel Antiparallel C
7978 C \ j|/k\| \ |/k\|l C
7983 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7985 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7986 C energy moment and not to the cluster cumulant.
7987 cd write (2,*) 'eello_graph4: wturn6',wturn6
7988 iti=itortyp(itype(i))
7989 itj=itortyp(itype(j))
7990 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7991 itj1=itortyp(itype(j+1))
7995 itk=itortyp(itype(k))
7996 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7997 itk1=itortyp(itype(k+1))
8001 itl=itortyp(itype(l))
8002 if (l.lt.nres-1) then
8003 itl1=itortyp(itype(l+1))
8007 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8008 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8009 cd & ' itl',itl,' itl1',itl1
8012 s1=dip(3,jj,i)*dip(3,kk,k)
8014 s1=dip(2,jj,j)*dip(2,kk,l)
8017 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8018 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8020 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8021 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8023 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8024 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8026 call transpose2(EUg(1,1,k),auxmat(1,1))
8027 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8028 vv(1)=pizda(1,1)-pizda(2,2)
8029 vv(2)=pizda(2,1)+pizda(1,2)
8030 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8031 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8033 eello6_graph4=-(s1+s2+s3+s4)
8035 eello6_graph4=-(s2+s3+s4)
8037 if (.not. calc_grad) return
8038 C Derivatives in gamma(i-1)
8042 s1=dipderg(2,jj,i)*dip(3,kk,k)
8044 s1=dipderg(4,jj,j)*dip(2,kk,l)
8047 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8049 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8050 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8052 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8053 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8055 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8056 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8057 cd write (2,*) 'turn6 derivatives'
8059 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8061 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8065 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8067 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8071 C Derivatives in gamma(k-1)
8074 s1=dip(3,jj,i)*dipderg(2,kk,k)
8076 s1=dip(2,jj,j)*dipderg(4,kk,l)
8079 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8080 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8082 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8083 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8085 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8086 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8088 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8089 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8090 vv(1)=pizda(1,1)-pizda(2,2)
8091 vv(2)=pizda(2,1)+pizda(1,2)
8092 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8093 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8095 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8097 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8101 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8103 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8106 C Derivatives in gamma(j-1) or gamma(l-1)
8107 if (l.eq.j+1 .and. l.gt.1) then
8108 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8109 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8110 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8111 vv(1)=pizda(1,1)-pizda(2,2)
8112 vv(2)=pizda(2,1)+pizda(1,2)
8113 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8114 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8115 else if (j.gt.1) then
8116 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8117 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8118 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8119 vv(1)=pizda(1,1)-pizda(2,2)
8120 vv(2)=pizda(2,1)+pizda(1,2)
8121 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8122 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8123 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8125 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8128 C Cartesian derivatives.
8135 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8137 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8141 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8143 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8147 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8149 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8151 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8152 & b1(1,itj1),auxvec(1))
8153 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8155 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8156 & b1(1,itl1),auxvec(1))
8157 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8159 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8161 vv(1)=pizda(1,1)-pizda(2,2)
8162 vv(2)=pizda(2,1)+pizda(1,2)
8163 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8165 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8167 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8170 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8173 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8176 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8178 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8180 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8184 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8186 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8189 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8191 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8199 c----------------------------------------------------------------------------
8200 double precision function eello_turn6(i,jj,kk)
8201 implicit real*8 (a-h,o-z)
8202 include 'DIMENSIONS'
8203 include 'DIMENSIONS.ZSCOPT'
8204 include 'COMMON.IOUNITS'
8205 include 'COMMON.CHAIN'
8206 include 'COMMON.DERIV'
8207 include 'COMMON.INTERACT'
8208 include 'COMMON.CONTACTS'
8209 include 'COMMON.TORSION'
8210 include 'COMMON.VAR'
8211 include 'COMMON.GEO'
8212 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8213 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8215 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8216 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8217 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8218 C the respective energy moment and not to the cluster cumulant.
8223 iti=itortyp(itype(i))
8224 itk=itortyp(itype(k))
8225 itk1=itortyp(itype(k+1))
8226 itl=itortyp(itype(l))
8227 itj=itortyp(itype(j))
8228 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8229 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8230 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8235 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8237 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8241 derx_turn(lll,kkk,iii)=0.0d0
8248 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8250 cd write (2,*) 'eello6_5',eello6_5
8252 call transpose2(AEA(1,1,1),auxmat(1,1))
8253 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8254 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8255 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8259 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8260 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8261 s2 = scalar2(b1(1,itk),vtemp1(1))
8263 call transpose2(AEA(1,1,2),atemp(1,1))
8264 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8265 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8266 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8270 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8271 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8272 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8274 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8275 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8276 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8277 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8278 ss13 = scalar2(b1(1,itk),vtemp4(1))
8279 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8283 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8289 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8291 C Derivatives in gamma(i+2)
8293 call transpose2(AEA(1,1,1),auxmatd(1,1))
8294 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8295 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8296 call transpose2(AEAderg(1,1,2),atempd(1,1))
8297 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8298 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8302 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8303 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8304 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8310 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8311 C Derivatives in gamma(i+3)
8313 call transpose2(AEA(1,1,1),auxmatd(1,1))
8314 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8315 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8316 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8320 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8321 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8322 s2d = scalar2(b1(1,itk),vtemp1d(1))
8324 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8325 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8327 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8329 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8330 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8331 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8341 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8342 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8344 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8345 & -0.5d0*ekont*(s2d+s12d)
8347 C Derivatives in gamma(i+4)
8348 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8349 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8350 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8352 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8353 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8354 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8364 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8366 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8368 C Derivatives in gamma(i+5)
8370 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8371 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8372 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8376 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8377 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8378 s2d = scalar2(b1(1,itk),vtemp1d(1))
8380 call transpose2(AEA(1,1,2),atempd(1,1))
8381 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8382 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8386 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8387 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8389 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8390 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8391 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8401 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8402 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8404 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8405 & -0.5d0*ekont*(s2d+s12d)
8407 C Cartesian derivatives
8412 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8413 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8414 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8418 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8419 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8421 s2d = scalar2(b1(1,itk),vtemp1d(1))
8423 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8424 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8425 s8d = -(atempd(1,1)+atempd(2,2))*
8426 & scalar2(cc(1,1,itl),vtemp2(1))
8430 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8432 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8433 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8440 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8443 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8447 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8448 & - 0.5d0*(s8d+s12d)
8450 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8459 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8461 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8462 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8463 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8464 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8465 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8467 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8468 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8469 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8473 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8474 cd & 16*eel_turn6_num
8476 if (j.lt.nres-1) then
8483 if (l.lt.nres-1) then
8491 ggg1(ll)=eel_turn6*g_contij(ll,1)
8492 ggg2(ll)=eel_turn6*g_contij(ll,2)
8493 ghalf=0.5d0*ggg1(ll)
8495 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8496 & +ekont*derx_turn(ll,2,1)
8497 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8498 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8499 & +ekont*derx_turn(ll,4,1)
8500 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8501 ghalf=0.5d0*ggg2(ll)
8503 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8504 & +ekont*derx_turn(ll,2,2)
8505 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8506 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8507 & +ekont*derx_turn(ll,4,2)
8508 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8513 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8518 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8524 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8529 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8533 cd write (2,*) iii,g_corr6_loc(iii)
8536 eello_turn6=ekont*eel_turn6
8537 cd write (2,*) 'ekont',ekont
8538 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8541 crc-------------------------------------------------
8542 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8543 subroutine Eliptransfer(eliptran)
8544 implicit real*8 (a-h,o-z)
8545 include 'DIMENSIONS'
8546 include 'COMMON.GEO'
8547 include 'COMMON.VAR'
8548 include 'COMMON.LOCAL'
8549 include 'COMMON.CHAIN'
8550 include 'COMMON.DERIV'
8551 include 'COMMON.INTERACT'
8552 include 'COMMON.IOUNITS'
8553 include 'COMMON.CALC'
8554 include 'COMMON.CONTROL'
8555 include 'COMMON.SPLITELE'
8556 include 'COMMON.SBRIDGE'
8557 C this is done by Adasko
8561 C--bordliptop-- buffore starts
8562 C--bufliptop--- here true lipid starts
8564 C--buflipbot--- lipid ends buffore starts
8565 C--bordlipbot--buffore ends
8569 if (itype(i).eq.ntyp1) cycle
8571 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8572 if (positi.le.0) positi=positi+boxzsize
8574 C first for peptide groups
8575 c for each residue check if it is in lipid or lipid water border area
8576 if ((positi.gt.bordlipbot)
8577 &.and.(positi.lt.bordliptop)) then
8578 C the energy transfer exist
8579 if (positi.lt.buflipbot) then
8580 C what fraction I am in
8582 & ((positi-bordlipbot)/lipbufthick)
8583 C lipbufthick is thickenes of lipid buffore
8584 sslip=sscalelip(fracinbuf)
8585 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8586 eliptran=eliptran+sslip*pepliptran
8587 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8588 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8589 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8590 elseif (positi.gt.bufliptop) then
8591 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8592 sslip=sscalelip(fracinbuf)
8593 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8594 eliptran=eliptran+sslip*pepliptran
8595 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8596 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8597 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8598 C print *, "doing sscalefor top part"
8599 C print *,i,sslip,fracinbuf,ssgradlip
8601 eliptran=eliptran+pepliptran
8602 C print *,"I am in true lipid"
8605 C eliptran=elpitran+0.0 ! I am in water
8608 C print *, "nic nie bylo w lipidzie?"
8609 C now multiply all by the peptide group transfer factor
8610 C eliptran=eliptran*pepliptran
8611 C now the same for side chains
8614 if (itype(i).eq.ntyp1) cycle
8615 positi=(mod(c(3,i+nres),boxzsize))
8616 if (positi.le.0) positi=positi+boxzsize
8617 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8618 c for each residue check if it is in lipid or lipid water border area
8619 C respos=mod(c(3,i+nres),boxzsize)
8620 C print *,positi,bordlipbot,buflipbot
8621 if ((positi.gt.bordlipbot)
8622 & .and.(positi.lt.bordliptop)) then
8623 C the energy transfer exist
8624 if (positi.lt.buflipbot) then
8626 & ((positi-bordlipbot)/lipbufthick)
8627 C lipbufthick is thickenes of lipid buffore
8628 sslip=sscalelip(fracinbuf)
8629 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8630 eliptran=eliptran+sslip*liptranene(itype(i))
8631 gliptranx(3,i)=gliptranx(3,i)
8632 &+ssgradlip*liptranene(itype(i))
8633 gliptranc(3,i-1)= gliptranc(3,i-1)
8634 &+ssgradlip*liptranene(itype(i))
8635 C print *,"doing sccale for lower part"
8636 elseif (positi.gt.bufliptop) then
8638 &((bordliptop-positi)/lipbufthick)
8639 sslip=sscalelip(fracinbuf)
8640 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8641 eliptran=eliptran+sslip*liptranene(itype(i))
8642 gliptranx(3,i)=gliptranx(3,i)
8643 &+ssgradlip*liptranene(itype(i))
8644 gliptranc(3,i-1)= gliptranc(3,i-1)
8645 &+ssgradlip*liptranene(itype(i))
8646 C print *, "doing sscalefor top part",sslip,fracinbuf
8648 eliptran=eliptran+liptranene(itype(i))
8649 C print *,"I am in true lipid"
8651 endif ! if in lipid or buffor
8653 C eliptran=elpitran+0.0 ! I am in water
8659 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8661 SUBROUTINE MATVEC2(A1,V1,V2)
8662 implicit real*8 (a-h,o-z)
8663 include 'DIMENSIONS'
8664 DIMENSION A1(2,2),V1(2),V2(2)
8668 c 3 VI=VI+A1(I,K)*V1(K)
8672 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8673 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8678 C---------------------------------------
8679 SUBROUTINE MATMAT2(A1,A2,A3)
8680 implicit real*8 (a-h,o-z)
8681 include 'DIMENSIONS'
8682 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8683 c DIMENSION AI3(2,2)
8687 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8693 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8694 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8695 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8696 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8704 c-------------------------------------------------------------------------
8705 double precision function scalar2(u,v)
8707 double precision u(2),v(2)
8710 scalar2=u(1)*v(1)+u(2)*v(2)
8714 C-----------------------------------------------------------------------------
8716 subroutine transpose2(a,at)
8718 double precision a(2,2),at(2,2)
8725 c--------------------------------------------------------------------------
8726 subroutine transpose(n,a,at)
8729 double precision a(n,n),at(n,n)
8737 C---------------------------------------------------------------------------
8738 subroutine prodmat3(a1,a2,kk,transp,prod)
8741 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8743 crc double precision auxmat(2,2),prod_(2,2)
8746 crc call transpose2(kk(1,1),auxmat(1,1))
8747 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8748 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8750 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8751 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8752 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8753 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8754 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8755 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8756 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8757 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8760 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8761 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8763 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8764 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8765 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8766 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8767 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8768 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8769 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8770 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8773 c call transpose2(a2(1,1),a2t(1,1))
8776 crc print *,((prod_(i,j),i=1,2),j=1,2)
8777 crc print *,((prod(i,j),i=1,2),j=1,2)
8781 C-----------------------------------------------------------------------------
8782 double precision function scalar(u,v)
8784 double precision u(3),v(3)
8794 C-----------------------------------------------------------------------
8795 double precision function sscale(r)
8796 double precision r,gamm
8797 include "COMMON.SPLITELE"
8798 if(r.lt.r_cut-rlamb) then
8800 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8801 gamm=(r-(r_cut-rlamb))/rlamb
8802 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8808 C-----------------------------------------------------------------------
8809 C-----------------------------------------------------------------------
8810 double precision function sscagrad(r)
8811 double precision r,gamm
8812 include "COMMON.SPLITELE"
8813 if(r.lt.r_cut-rlamb) then
8815 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8816 gamm=(r-(r_cut-rlamb))/rlamb
8817 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8823 C-----------------------------------------------------------------------
8824 C-----------------------------------------------------------------------
8825 double precision function sscalelip(r)
8826 double precision r,gamm
8827 include "COMMON.SPLITELE"
8828 C if(r.lt.r_cut-rlamb) then
8830 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8831 C gamm=(r-(r_cut-rlamb))/rlamb
8832 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8838 C-----------------------------------------------------------------------
8839 double precision function sscagradlip(r)
8840 double precision r,gamm
8841 include "COMMON.SPLITELE"
8842 C if(r.lt.r_cut-rlamb) then
8844 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8845 C gamm=(r-(r_cut-rlamb))/rlamb
8846 sscagradlip=r*(6*r-6.0d0)
8853 C-----------------------------------------------------------------------
8854 subroutine set_shield_fac
8855 implicit real*8 (a-h,o-z)
8856 include 'DIMENSIONS'
8857 include 'COMMON.CHAIN'
8858 include 'COMMON.DERIV'
8859 include 'COMMON.IOUNITS'
8860 include 'COMMON.SHIELD'
8861 include 'COMMON.INTERACT'
8862 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8863 double precision div77_81/0.974996043d0/,
8864 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8866 C the vector between center of side_chain and peptide group
8867 double precision pep_side(3),long,side_calf(3),
8868 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8869 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8870 C the line belowe needs to be changed for FGPROC>1
8872 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8874 Cif there two consequtive dummy atoms there is no peptide group between them
8875 C the line below has to be changed for FGPROC>1
8878 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8882 C first lets set vector conecting the ithe side-chain with kth side-chain
8883 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8885 C and vector conecting the side-chain with its proper calfa
8886 side_calf(j)=c(j,k+nres)-c(j,k)
8887 C side_calf(j)=2.0d0
8888 pept_group(j)=c(j,i)-c(j,i+1)
8889 C lets have their lenght
8890 dist_pep_side=pep_side(j)**2+dist_pep_side
8891 dist_side_calf=dist_side_calf+side_calf(j)**2
8892 dist_pept_group=dist_pept_group+pept_group(j)**2
8894 dist_pep_side=dsqrt(dist_pep_side)
8895 dist_pept_group=dsqrt(dist_pept_group)
8896 dist_side_calf=dsqrt(dist_side_calf)
8898 pep_side_norm(j)=pep_side(j)/dist_pep_side
8899 side_calf_norm(j)=dist_side_calf
8901 C now sscale fraction
8902 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8903 C print *,buff_shield,"buff"
8905 if (sh_frac_dist.le.0.0) cycle
8906 C If we reach here it means that this side chain reaches the shielding sphere
8907 C Lets add him to the list for gradient
8908 ishield_list(i)=ishield_list(i)+1
8909 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8910 C this list is essential otherwise problem would be O3
8911 shield_list(ishield_list(i),i)=k
8912 C Lets have the sscale value
8913 if (sh_frac_dist.gt.1.0) then
8914 scale_fac_dist=1.0d0
8916 sh_frac_dist_grad(j)=0.0d0
8919 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8920 & *(2.0*sh_frac_dist-3.0d0)
8921 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8922 & /dist_pep_side/buff_shield*0.5
8923 C remember for the final gradient multiply sh_frac_dist_grad(j)
8924 C for side_chain by factor -2 !
8926 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8927 C print *,"jestem",scale_fac_dist,fac_help_scale,
8928 C & sh_frac_dist_grad(j)
8931 C if ((i.eq.3).and.(k.eq.2)) then
8932 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8936 C this is what is now we have the distance scaling now volume...
8937 short=short_r_sidechain(itype(k))
8938 long=long_r_sidechain(itype(k))
8939 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8942 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8945 costhet_grad(j)=costhet_fac*pep_side(j)
8947 C remember for the final gradient multiply costhet_grad(j)
8948 C for side_chain by factor -2 !
8949 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8950 C pep_side0pept_group is vector multiplication
8951 pep_side0pept_group=0.0
8953 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8955 cosalfa=(pep_side0pept_group/
8956 & (dist_pep_side*dist_side_calf))
8957 fac_alfa_sin=1.0-cosalfa**2
8958 fac_alfa_sin=dsqrt(fac_alfa_sin)
8959 rkprim=fac_alfa_sin*(long-short)+short
8961 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8962 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8965 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8966 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8967 &*(long-short)/fac_alfa_sin*cosalfa/
8968 &((dist_pep_side*dist_side_calf))*
8969 &((side_calf(j))-cosalfa*
8970 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8972 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8973 &*(long-short)/fac_alfa_sin*cosalfa
8974 &/((dist_pep_side*dist_side_calf))*
8976 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8979 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8982 C now the gradient...
8983 C grad_shield is gradient of Calfa for peptide groups
8984 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8986 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8987 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8989 grad_shield(j,i)=grad_shield(j,i)
8990 C gradient po skalowaniu
8991 & +(sh_frac_dist_grad(j)
8992 C gradient po costhet
8993 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8994 &-scale_fac_dist*(cosphi_grad_long(j))
8995 &/(1.0-cosphi) )*div77_81
8997 C grad_shield_side is Cbeta sidechain gradient
8998 grad_shield_side(j,ishield_list(i),i)=
8999 & (sh_frac_dist_grad(j)*-2.0d0
9000 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9001 & +scale_fac_dist*(cosphi_grad_long(j))
9002 & *2.0d0/(1.0-cosphi))
9003 & *div77_81*VofOverlap
9005 grad_shield_loc(j,ishield_list(i),i)=
9006 & scale_fac_dist*cosphi_grad_loc(j)
9007 & *2.0d0/(1.0-cosphi)
9008 & *div77_81*VofOverlap
9010 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9012 fac_shield(i)=VolumeTotal*div77_81+div4_81
9013 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9017 C--------------------------------------------------------------------------
9018 C first for shielding is setting of function of side-chains
9019 subroutine set_shield_fac2
9020 implicit real*8 (a-h,o-z)
9021 include 'DIMENSIONS'
9022 include 'COMMON.CHAIN'
9023 include 'COMMON.DERIV'
9024 include 'COMMON.IOUNITS'
9025 include 'COMMON.SHIELD'
9026 include 'COMMON.INTERACT'
9027 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9028 double precision div77_81/0.974996043d0/,
9029 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9031 C the vector between center of side_chain and peptide group
9032 double precision pep_side(3),long,side_calf(3),
9033 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9034 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9035 C the line belowe needs to be changed for FGPROC>1
9037 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9039 Cif there two consequtive dummy atoms there is no peptide group between them
9040 C the line below has to be changed for FGPROC>1
9043 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9047 C first lets set vector conecting the ithe side-chain with kth side-chain
9048 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9050 C and vector conecting the side-chain with its proper calfa
9051 side_calf(j)=c(j,k+nres)-c(j,k)
9052 C side_calf(j)=2.0d0
9053 pept_group(j)=c(j,i)-c(j,i+1)
9054 C lets have their lenght
9055 dist_pep_side=pep_side(j)**2+dist_pep_side
9056 dist_side_calf=dist_side_calf+side_calf(j)**2
9057 dist_pept_group=dist_pept_group+pept_group(j)**2
9059 dist_pep_side=dsqrt(dist_pep_side)
9060 dist_pept_group=dsqrt(dist_pept_group)
9061 dist_side_calf=dsqrt(dist_side_calf)
9063 pep_side_norm(j)=pep_side(j)/dist_pep_side
9064 side_calf_norm(j)=dist_side_calf
9066 C now sscale fraction
9067 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9068 C print *,buff_shield,"buff"
9070 if (sh_frac_dist.le.0.0) cycle
9071 C If we reach here it means that this side chain reaches the shielding sphere
9072 C Lets add him to the list for gradient
9073 ishield_list(i)=ishield_list(i)+1
9074 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9075 C this list is essential otherwise problem would be O3
9076 shield_list(ishield_list(i),i)=k
9077 C Lets have the sscale value
9078 if (sh_frac_dist.gt.1.0) then
9079 scale_fac_dist=1.0d0
9081 sh_frac_dist_grad(j)=0.0d0
9084 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9085 & *(2.0d0*sh_frac_dist-3.0d0)
9086 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9087 & /dist_pep_side/buff_shield*0.5d0
9088 C remember for the final gradient multiply sh_frac_dist_grad(j)
9089 C for side_chain by factor -2 !
9091 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9092 C sh_frac_dist_grad(j)=0.0d0
9093 C scale_fac_dist=1.0d0
9094 C print *,"jestem",scale_fac_dist,fac_help_scale,
9095 C & sh_frac_dist_grad(j)
9098 C this is what is now we have the distance scaling now volume...
9099 short=short_r_sidechain(itype(k))
9100 long=long_r_sidechain(itype(k))
9101 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9102 sinthet=short/dist_pep_side*costhet
9106 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9107 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9108 C & -short/dist_pep_side**2/costhet)
9111 costhet_grad(j)=costhet_fac*pep_side(j)
9113 C remember for the final gradient multiply costhet_grad(j)
9114 C for side_chain by factor -2 !
9115 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9116 C pep_side0pept_group is vector multiplication
9117 pep_side0pept_group=0.0d0
9119 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9121 cosalfa=(pep_side0pept_group/
9122 & (dist_pep_side*dist_side_calf))
9123 fac_alfa_sin=1.0d0-cosalfa**2
9124 fac_alfa_sin=dsqrt(fac_alfa_sin)
9125 rkprim=fac_alfa_sin*(long-short)+short
9129 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9131 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9132 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9136 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9137 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9138 &*(long-short)/fac_alfa_sin*cosalfa/
9139 &((dist_pep_side*dist_side_calf))*
9140 &((side_calf(j))-cosalfa*
9141 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9142 C cosphi_grad_long(j)=0.0d0
9143 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9144 &*(long-short)/fac_alfa_sin*cosalfa
9145 &/((dist_pep_side*dist_side_calf))*
9147 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9148 C cosphi_grad_loc(j)=0.0d0
9150 C print *,sinphi,sinthet
9151 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9154 C now the gradient...
9156 grad_shield(j,i)=grad_shield(j,i)
9157 C gradient po skalowaniu
9158 & +(sh_frac_dist_grad(j)*VofOverlap
9159 C gradient po costhet
9160 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9161 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9162 & sinphi/sinthet*costhet*costhet_grad(j)
9163 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9165 C grad_shield_side is Cbeta sidechain gradient
9166 grad_shield_side(j,ishield_list(i),i)=
9167 & (sh_frac_dist_grad(j)*-2.0d0
9169 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9170 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9171 & sinphi/sinthet*costhet*costhet_grad(j)
9172 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9175 grad_shield_loc(j,ishield_list(i),i)=
9176 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9177 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9178 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9182 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9184 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9185 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9186 C write(2,*) "TU",rpp(1,1),short,long,buff_shield