1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
9 cMS$ATTRIBUTES C :: proc_proc
12 include 'COMMON.IOUNITS'
13 double precision energia(0:max_ene),energia1(0:max_ene+1)
14 include 'COMMON.FFIELD'
15 include 'COMMON.DERIV'
16 include 'COMMON.INTERACT'
17 include 'COMMON.SBRIDGE'
18 include 'COMMON.CHAIN'
19 include 'COMMON.SHIELD'
20 include 'COMMON.CONTROL'
21 include 'COMMON.TORCNSTR'
22 double precision fact(6)
23 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
25 cd print *,'nnt=',nnt,' nct=',nct
27 C Compute the side-chain and electrostatic interaction energy
29 goto (101,102,103,104,105) ipot
30 C Lennard-Jones potential.
31 101 call elj(evdw,evdw_t)
32 cd print '(a)','Exit ELJ'
34 C Lennard-Jones-Kihara potential (shifted).
35 102 call eljk(evdw,evdw_t)
37 C Berne-Pechukas potential (dilated LJ, angular dependence).
38 103 call ebp(evdw,evdw_t)
40 C Gay-Berne potential (shifted LJ, angular dependence).
41 104 call egb(evdw,evdw_t)
43 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
44 105 call egbv(evdw,evdw_t)
46 C Calculate electrostatic (H-bonding) energy of the main chain.
49 c write (iout,*) "Sidechain"
52 if (shield_mode.eq.1) then
54 else if (shield_mode.eq.2) then
57 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
58 c write(iout,*) 'po eelec'
61 C Calculate excluded-volume interaction energy between peptide groups
64 call escp(evdw2,evdw2_14)
66 c Calculate the bond-stretching energy
70 C write (iout,*) "estr",estr
72 C Calculate the disulfide-bridge and other energy and the contributions
73 C from other distance constraints.
74 cd print *,'Calling EHPB'
76 cd print *,'EHPB exitted succesfully.'
78 C Calculate the virtual-bond-angle energy.
80 C print *,'Bend energy finished.'
82 if (tor_mode.eq.0) then
85 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
93 if (with_theta_constr) call etheta_constr(ethetacnstr)
94 c call ebend(ebe,ethetacnstr)
95 cd print *,'Bend energy finished.'
97 C Calculate the SC local energy.
100 C print *,'SCLOC energy finished.'
102 C Calculate the virtual-bond torsional energy.
104 if (wtor.gt.0.0d0) then
105 if (tor_mode.eq.0) then
106 call etor(etors,fact(1))
108 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
110 call etor_kcc(etors,fact(1))
116 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
117 c print *,"Processor",myrank," computed Utor"
119 C 6/23/01 Calculate double-torsional energy
121 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
122 call etor_d(etors_d,fact(2))
126 c print *,"Processor",myrank," computed Utord"
128 call eback_sc_corr(esccor)
130 if (wliptran.gt.0) then
131 call Eliptransfer(eliptran)
135 C 12/1/95 Multi-body terms
139 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
140 & .or. wturn6.gt.0.0d0) then
141 c write(iout,*)"calling multibody_eello"
142 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
143 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
144 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
151 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
152 c write (iout,*) "Calling multibody_hbond"
153 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
155 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
157 if (shield_mode.gt.0) then
158 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
160 & +fact(1)*wvdwpp*evdw1
161 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
162 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
163 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
164 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
165 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
166 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
169 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
171 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
172 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
173 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
174 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
175 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
176 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
180 if (shield_mode.gt.0) then
181 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
182 & +welec*fact(1)*(ees+evdw1)
183 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
184 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
185 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
186 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
187 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
188 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
191 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
192 & +welec*fact(1)*(ees+evdw1)
193 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
194 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
195 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
196 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
197 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
198 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
205 energia(2)=evdw2-evdw2_14
222 energia(8)=eello_turn3
223 energia(9)=eello_turn4
232 energia(20)=edihcnstr
234 energia(24)=ethetacnstr
239 if (isnan(etot).ne.0) energia(0)=1.0d+99
241 if (isnan(etot)) energia(0)=1.0d+99
246 idumm=proc_proc(etot,i)
248 call proc_proc(etot,i)
250 if(i.eq.1)energia(0)=1.0d+99
256 call enerprint(energia,fact)
260 C Sum up the components of the Cartesian gradient.
265 if (shield_mode.eq.0) then
266 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
267 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
269 & wstrain*ghpbc(j,i)+
270 & wcorr*fact(3)*gradcorr(j,i)+
271 & wel_loc*fact(2)*gel_loc(j,i)+
272 & wturn3*fact(2)*gcorr3_turn(j,i)+
273 & wturn4*fact(3)*gcorr4_turn(j,i)+
274 & wcorr5*fact(4)*gradcorr5(j,i)+
275 & wcorr6*fact(5)*gradcorr6(j,i)+
276 & wturn6*fact(5)*gcorr6_turn(j,i)+
277 & wsccor*fact(2)*gsccorc(j,i)
278 & +wliptran*gliptranc(j,i)
279 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
281 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
282 & wsccor*fact(2)*gsccorx(j,i)
283 & +wliptran*gliptranx(j,i)
285 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
286 & +fact(1)*wscp*gvdwc_scp(j,i)+
287 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
289 & wstrain*ghpbc(j,i)+
290 & wcorr*fact(3)*gradcorr(j,i)+
291 & wel_loc*fact(2)*gel_loc(j,i)+
292 & wturn3*fact(2)*gcorr3_turn(j,i)+
293 & wturn4*fact(3)*gcorr4_turn(j,i)+
294 & wcorr5*fact(4)*gradcorr5(j,i)+
295 & wcorr6*fact(5)*gradcorr6(j,i)+
296 & wturn6*fact(5)*gcorr6_turn(j,i)+
297 & wsccor*fact(2)*gsccorc(j,i)
298 & +wliptran*gliptranc(j,i)
299 & +welec*gshieldc(j,i)
300 & +welec*gshieldc_loc(j,i)
301 & +wcorr*gshieldc_ec(j,i)
302 & +wcorr*gshieldc_loc_ec(j,i)
303 & +wturn3*gshieldc_t3(j,i)
304 & +wturn3*gshieldc_loc_t3(j,i)
305 & +wturn4*gshieldc_t4(j,i)
306 & +wturn4*gshieldc_loc_t4(j,i)
307 & +wel_loc*gshieldc_ll(j,i)
308 & +wel_loc*gshieldc_loc_ll(j,i)
310 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
311 & +fact(1)*wscp*gradx_scp(j,i)+
313 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
314 & wsccor*fact(2)*gsccorx(j,i)
315 & +wliptran*gliptranx(j,i)
316 & +welec*gshieldx(j,i)
317 & +wcorr*gshieldx_ec(j,i)
318 & +wturn3*gshieldx_t3(j,i)
319 & +wturn4*gshieldx_t4(j,i)
320 & +wel_loc*gshieldx_ll(j,i)
328 if (shield_mode.eq.0) then
329 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
330 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
332 & wcorr*fact(3)*gradcorr(j,i)+
333 & wel_loc*fact(2)*gel_loc(j,i)+
334 & wturn3*fact(2)*gcorr3_turn(j,i)+
335 & wturn4*fact(3)*gcorr4_turn(j,i)+
336 & wcorr5*fact(4)*gradcorr5(j,i)+
337 & wcorr6*fact(5)*gradcorr6(j,i)+
338 & wturn6*fact(5)*gcorr6_turn(j,i)+
339 & wsccor*fact(2)*gsccorc(j,i)
340 & +wliptran*gliptranc(j,i)
341 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
343 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
344 & wsccor*fact(1)*gsccorx(j,i)
345 & +wliptran*gliptranx(j,i)
347 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
348 & fact(1)*wscp*gvdwc_scp(j,i)+
349 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
351 & wcorr*fact(3)*gradcorr(j,i)+
352 & wel_loc*fact(2)*gel_loc(j,i)+
353 & wturn3*fact(2)*gcorr3_turn(j,i)+
354 & wturn4*fact(3)*gcorr4_turn(j,i)+
355 & wcorr5*fact(4)*gradcorr5(j,i)+
356 & wcorr6*fact(5)*gradcorr6(j,i)+
357 & wturn6*fact(5)*gcorr6_turn(j,i)+
358 & wsccor*fact(2)*gsccorc(j,i)
359 & +wliptran*gliptranc(j,i)
360 & +welec*gshieldc(j,i)
361 & +welec*gshieldc_loc(j,i)
362 & +wcorr*gshieldc_ec(j,i)
363 & +wcorr*gshieldc_loc_ec(j,i)
364 & +wturn3*gshieldc_t3(j,i)
365 & +wturn3*gshieldc_loc_t3(j,i)
366 & +wturn4*gshieldc_t4(j,i)
367 & +wturn4*gshieldc_loc_t4(j,i)
368 & +wel_loc*gshieldc_ll(j,i)
369 & +wel_loc*gshieldc_loc_ll(j,i)
371 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
372 & fact(1)*wscp*gradx_scp(j,i)+
374 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
375 & wsccor*fact(1)*gsccorx(j,i)
376 & +wliptran*gliptranx(j,i)
377 & +welec*gshieldx(j,i)
378 & +wcorr*gshieldx_ec(j,i)
379 & +wturn3*gshieldx_t3(j,i)
380 & +wturn4*gshieldx_t4(j,i)
381 & +wel_loc*gshieldx_ll(j,i)
390 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
391 & +wcorr5*fact(4)*g_corr5_loc(i)
392 & +wcorr6*fact(5)*g_corr6_loc(i)
393 & +wturn4*fact(3)*gel_loc_turn4(i)
394 & +wturn3*fact(2)*gel_loc_turn3(i)
395 & +wturn6*fact(5)*gel_loc_turn6(i)
396 & +wel_loc*fact(2)*gel_loc_loc(i)
397 c & +wsccor*fact(1)*gsccor_loc(i)
398 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
401 if (dyn_ss) call dyn_set_nss
404 C------------------------------------------------------------------------
405 subroutine enerprint(energia,fact)
406 implicit real*8 (a-h,o-z)
408 include 'COMMON.IOUNITS'
409 include 'COMMON.FFIELD'
410 include 'COMMON.SBRIDGE'
411 double precision energia(0:max_ene),fact(6)
413 evdw=energia(1)+fact(6)*energia(21)
415 evdw2=energia(2)+energia(17)
427 eello_turn3=energia(8)
428 eello_turn4=energia(9)
429 eello_turn6=energia(10)
436 edihcnstr=energia(20)
438 ethetacnstr=energia(24)
441 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
443 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
444 & etors_d,wtor_d*fact(2),ehpb,wstrain,
445 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
446 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
447 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
448 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
449 & eliptran,wliptran,etot
450 10 format (/'Virtual-chain energies:'//
451 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
452 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
453 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
454 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
455 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
456 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
457 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
458 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
459 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
460 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
461 & ' (SS bridges & dist. cnstr.)'/
462 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
463 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
464 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
465 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
466 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
467 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
468 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
469 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
470 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
471 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
472 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
473 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
474 & 'ETOT= ',1pE16.6,' (total)')
476 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
477 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
478 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
479 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
480 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
481 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
482 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot
483 10 format (/'Virtual-chain energies:'//
484 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
485 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
486 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
487 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
488 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
489 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
490 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
491 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
492 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
493 & ' (SS bridges & dist. cnstr.)'/
494 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
495 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
496 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
497 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
498 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
499 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
500 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
501 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
502 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
503 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
504 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
505 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
506 & 'ETOT= ',1pE16.6,' (total)')
510 C-----------------------------------------------------------------------
511 subroutine elj(evdw,evdw_t)
513 C This subroutine calculates the interaction energy of nonbonded side chains
514 C assuming the LJ potential of interaction.
516 implicit real*8 (a-h,o-z)
518 include "DIMENSIONS.COMPAR"
519 parameter (accur=1.0d-10)
522 include 'COMMON.LOCAL'
523 include 'COMMON.CHAIN'
524 include 'COMMON.DERIV'
525 include 'COMMON.INTERACT'
526 include 'COMMON.TORSION'
527 include 'COMMON.SBRIDGE'
528 include 'COMMON.NAMES'
529 include 'COMMON.IOUNITS'
530 include 'COMMON.CONTACTS'
534 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
538 c eneps_temp(j,i)=0.0d0
547 if (itypi.eq.ntyp1) cycle
548 itypi1=iabs(itype(i+1))
555 C Calculate SC interaction energy.
558 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
559 cd & 'iend=',iend(i,iint)
560 do j=istart(i,iint),iend(i,iint)
562 if (itypj.eq.ntyp1) cycle
566 C Change 12/1/95 to calculate four-body interactions
567 rij=xj*xj+yj*yj+zj*zj
569 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
570 eps0ij=eps(itypi,itypj)
575 ij=icant(itypi,itypj)
577 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
578 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
581 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
582 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
583 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
584 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
585 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
586 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
587 if (bb.gt.0.0d0) then
594 C Calculate the components of the gradient in DC and X
596 fac=-rrij*(e1+evdwij)
601 gvdwx(k,i)=gvdwx(k,i)-gg(k)
602 gvdwx(k,j)=gvdwx(k,j)+gg(k)
606 gvdwc(l,k)=gvdwc(l,k)+gg(l)
611 C 12/1/95, revised on 5/20/97
613 C Calculate the contact function. The ith column of the array JCONT will
614 C contain the numbers of atoms that make contacts with the atom I (of numbers
615 C greater than I). The arrays FACONT and GACONT will contain the values of
616 C the contact function and its derivative.
618 C Uncomment next line, if the correlation interactions include EVDW explicitly.
619 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
620 C Uncomment next line, if the correlation interactions are contact function only
621 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
623 sigij=sigma(itypi,itypj)
624 r0ij=rs0(itypi,itypj)
626 C Check whether the SC's are not too far to make a contact.
629 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
630 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
632 if (fcont.gt.0.0D0) then
633 C If the SC-SC distance if close to sigma, apply spline.
634 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
635 cAdam & fcont1,fprimcont1)
636 cAdam fcont1=1.0d0-fcont1
637 cAdam if (fcont1.gt.0.0d0) then
638 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
639 cAdam fcont=fcont*fcont1
641 C Uncomment following 4 lines to have the geometric average of the epsilon0's
642 cga eps0ij=1.0d0/dsqrt(eps0ij)
644 cga gg(k)=gg(k)*eps0ij
646 cga eps0ij=-evdwij*eps0ij
647 C Uncomment for AL's type of SC correlation interactions.
649 num_conti=num_conti+1
651 facont(num_conti,i)=fcont*eps0ij
652 fprimcont=eps0ij*fprimcont/rij
654 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
655 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
656 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
657 C Uncomment following 3 lines for Skolnick's type of SC correlation.
658 gacont(1,num_conti,i)=-fprimcont*xj
659 gacont(2,num_conti,i)=-fprimcont*yj
660 gacont(3,num_conti,i)=-fprimcont*zj
661 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
662 cd write (iout,'(2i3,3f10.5)')
663 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
669 num_cont(i)=num_conti
674 gvdwc(j,i)=expon*gvdwc(j,i)
675 gvdwx(j,i)=expon*gvdwx(j,i)
679 C******************************************************************************
683 C To save time, the factor of EXPON has been extracted from ALL components
684 C of GVDWC and GRADX. Remember to multiply them by this factor before further
687 C******************************************************************************
690 C-----------------------------------------------------------------------------
691 subroutine eljk(evdw,evdw_t)
693 C This subroutine calculates the interaction energy of nonbonded side chains
694 C assuming the LJK potential of interaction.
696 implicit real*8 (a-h,o-z)
698 include "DIMENSIONS.COMPAR"
701 include 'COMMON.LOCAL'
702 include 'COMMON.CHAIN'
703 include 'COMMON.DERIV'
704 include 'COMMON.INTERACT'
705 include 'COMMON.IOUNITS'
706 include 'COMMON.NAMES'
711 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
714 c eneps_temp(j,i)=0.0d0
721 if (itypi.eq.ntyp1) cycle
722 itypi1=iabs(itype(i+1))
727 C Calculate SC interaction energy.
730 do j=istart(i,iint),iend(i,iint)
732 if (itypj.eq.ntyp1) cycle
736 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
738 e_augm=augm(itypi,itypj)*fac_augm
741 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
742 fac=r_shift_inv**expon
746 ij=icant(itypi,itypj)
747 c eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
748 c & /dabs(eps(itypi,itypj))
749 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
750 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
751 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
752 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
753 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
754 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
755 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
756 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
757 if (bb.gt.0.0d0) then
764 C Calculate the components of the gradient in DC and X
766 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
771 gvdwx(k,i)=gvdwx(k,i)-gg(k)
772 gvdwx(k,j)=gvdwx(k,j)+gg(k)
776 gvdwc(l,k)=gvdwc(l,k)+gg(l)
786 gvdwc(j,i)=expon*gvdwc(j,i)
787 gvdwx(j,i)=expon*gvdwx(j,i)
793 C-----------------------------------------------------------------------------
794 subroutine ebp(evdw,evdw_t)
796 C This subroutine calculates the interaction energy of nonbonded side chains
797 C assuming the Berne-Pechukas potential of interaction.
799 implicit real*8 (a-h,o-z)
801 include "DIMENSIONS.COMPAR"
804 include 'COMMON.LOCAL'
805 include 'COMMON.CHAIN'
806 include 'COMMON.DERIV'
807 include 'COMMON.NAMES'
808 include 'COMMON.INTERACT'
809 include 'COMMON.IOUNITS'
810 include 'COMMON.CALC'
812 c double precision rrsave(maxdim)
818 c eneps_temp(j,i)=0.0d0
823 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
824 c if (icall.eq.0) then
832 if (itypi.eq.ntyp1) cycle
833 itypi1=iabs(itype(i+1))
837 dxi=dc_norm(1,nres+i)
838 dyi=dc_norm(2,nres+i)
839 dzi=dc_norm(3,nres+i)
840 dsci_inv=vbld_inv(i+nres)
842 C Calculate SC interaction energy.
845 do j=istart(i,iint),iend(i,iint)
848 if (itypj.eq.ntyp1) cycle
849 dscj_inv=vbld_inv(j+nres)
850 chi1=chi(itypi,itypj)
851 chi2=chi(itypj,itypi)
858 alf12=0.5D0*(alf1+alf2)
859 C For diagnostics only!!!
872 dxj=dc_norm(1,nres+j)
873 dyj=dc_norm(2,nres+j)
874 dzj=dc_norm(3,nres+j)
875 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
876 cd if (icall.eq.0) then
882 C Calculate the angle-dependent terms of energy & contributions to derivatives.
884 C Calculate whole angle-dependent part of epsilon and contributions
886 fac=(rrij*sigsq)**expon2
889 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
890 eps2der=evdwij*eps3rt
891 eps3der=evdwij*eps2rt
892 evdwij=evdwij*eps2rt*eps3rt
893 ij=icant(itypi,itypj)
894 aux=eps1*eps2rt**2*eps3rt**2
895 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
896 c & /dabs(eps(itypi,itypj))
897 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
898 if (bb.gt.0.0d0) then
905 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
907 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
908 & restyp(itypi),i,restyp(itypj),j,
909 & epsi,sigm,chi1,chi2,chip1,chip2,
910 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
911 & om1,om2,om12,1.0D0/dsqrt(rrij),
914 C Calculate gradient components.
915 e1=e1*eps1*eps2rt**2*eps3rt**2
916 fac=-expon*(e1+evdwij)
919 C Calculate radial part of the gradient
923 C Calculate the angular part of the gradient and sum add the contributions
924 C to the appropriate components of the Cartesian gradient.
933 C-----------------------------------------------------------------------------
934 subroutine egb(evdw,evdw_t)
936 C This subroutine calculates the interaction energy of nonbonded side chains
937 C assuming the Gay-Berne potential of interaction.
939 implicit real*8 (a-h,o-z)
941 include "DIMENSIONS.COMPAR"
944 include 'COMMON.LOCAL'
945 include 'COMMON.CHAIN'
946 include 'COMMON.DERIV'
947 include 'COMMON.NAMES'
948 include 'COMMON.INTERACT'
949 include 'COMMON.IOUNITS'
950 include 'COMMON.CALC'
951 include 'COMMON.SBRIDGE'
954 integer icant,xshift,yshift,zshift
958 c eneps_temp(j,i)=0.0d0
961 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
965 c if (icall.gt.0) lprn=.true.
969 if (itypi.eq.ntyp1) cycle
970 itypi1=iabs(itype(i+1))
974 C returning the ith atom to box
976 if (xi.lt.0) xi=xi+boxxsize
978 if (yi.lt.0) yi=yi+boxysize
980 if (zi.lt.0) zi=zi+boxzsize
981 if ((zi.gt.bordlipbot)
982 &.and.(zi.lt.bordliptop)) then
983 C the energy transfer exist
984 if (zi.lt.buflipbot) then
985 C what fraction I am in
987 & ((zi-bordlipbot)/lipbufthick)
988 C lipbufthick is thickenes of lipid buffore
989 sslipi=sscalelip(fracinbuf)
990 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
991 elseif (zi.gt.bufliptop) then
992 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
993 sslipi=sscalelip(fracinbuf)
994 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1004 dxi=dc_norm(1,nres+i)
1005 dyi=dc_norm(2,nres+i)
1006 dzi=dc_norm(3,nres+i)
1007 dsci_inv=vbld_inv(i+nres)
1009 C Calculate SC interaction energy.
1011 do iint=1,nint_gr(i)
1012 do j=istart(i,iint),iend(i,iint)
1013 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1014 call dyn_ssbond_ene(i,j,evdwij)
1016 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1017 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1018 C triple bond artifac removal
1019 do k=j+1,iend(i,iint)
1020 C search over all next residues
1021 if (dyn_ss_mask(k)) then
1022 C check if they are cysteins
1023 C write(iout,*) 'k=',k
1024 call triple_ssbond_ene(i,j,k,evdwij)
1025 C call the energy function that removes the artifical triple disulfide
1026 C bond the soubroutine is located in ssMD.F
1028 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1029 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1030 endif!dyn_ss_mask(k)
1034 itypj=iabs(itype(j))
1035 if (itypj.eq.ntyp1) cycle
1036 dscj_inv=vbld_inv(j+nres)
1037 sig0ij=sigma(itypi,itypj)
1038 chi1=chi(itypi,itypj)
1039 chi2=chi(itypj,itypi)
1046 alf12=0.5D0*(alf1+alf2)
1047 C For diagnostics only!!!
1060 C returning jth atom to box
1062 if (xj.lt.0) xj=xj+boxxsize
1064 if (yj.lt.0) yj=yj+boxysize
1066 if (zj.lt.0) zj=zj+boxzsize
1067 if ((zj.gt.bordlipbot)
1068 &.and.(zj.lt.bordliptop)) then
1069 C the energy transfer exist
1070 if (zj.lt.buflipbot) then
1071 C what fraction I am in
1073 & ((zj-bordlipbot)/lipbufthick)
1074 C lipbufthick is thickenes of lipid buffore
1075 sslipj=sscalelip(fracinbuf)
1076 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1077 elseif (zj.gt.bufliptop) then
1078 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1079 sslipj=sscalelip(fracinbuf)
1080 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1089 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1090 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1091 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1092 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1093 C if (aa.ne.aa_aq(itypi,itypj)) then
1095 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1096 C & bb_aq(itypi,itypj)-bb,
1100 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1101 C checking the distance
1102 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1107 C finding the closest
1111 xj=xj_safe+xshift*boxxsize
1112 yj=yj_safe+yshift*boxysize
1113 zj=zj_safe+zshift*boxzsize
1114 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1115 if(dist_temp.lt.dist_init) then
1125 if (subchap.eq.1) then
1135 dxj=dc_norm(1,nres+j)
1136 dyj=dc_norm(2,nres+j)
1137 dzj=dc_norm(3,nres+j)
1138 c write (iout,*) i,j,xj,yj,zj
1139 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1141 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1142 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1143 if (sss.le.0.0) cycle
1144 C Calculate angle-dependent terms of energy and contributions to their
1149 sig=sig0ij*dsqrt(sigsq)
1150 rij_shift=1.0D0/rij-sig+sig0ij
1151 C I hate to put IF's in the loops, but here don't have another choice!!!!
1152 if (rij_shift.le.0.0D0) then
1157 c---------------------------------------------------------------
1158 rij_shift=1.0D0/rij_shift
1159 fac=rij_shift**expon
1162 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1163 eps2der=evdwij*eps3rt
1164 eps3der=evdwij*eps2rt
1165 evdwij=evdwij*eps2rt*eps3rt
1167 evdw=evdw+evdwij*sss
1169 evdw_t=evdw_t+evdwij*sss
1171 ij=icant(itypi,itypj)
1172 aux=eps1*eps2rt**2*eps3rt**2
1173 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1174 c & /dabs(eps(itypi,itypj))
1175 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1176 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1177 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1178 c & aux*e2/eps(itypi,itypj)
1180 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1184 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1185 & restyp(itypi),i,restyp(itypj),j,
1186 & epsi,sigm,chi1,chi2,chip1,chip2,
1187 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1188 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1190 write (iout,*) "partial sum", evdw, evdw_t
1195 C Calculate gradient components.
1196 e1=e1*eps1*eps2rt**2*eps3rt**2
1197 fac=-expon*(e1+evdwij)*rij_shift
1200 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1201 C Calculate the radial part of the gradient
1205 C Calculate angular part of the gradient.
1208 C write(iout,*) "partial sum", evdw, evdw_t
1215 C-----------------------------------------------------------------------------
1216 subroutine egbv(evdw,evdw_t)
1218 C This subroutine calculates the interaction energy of nonbonded side chains
1219 C assuming the Gay-Berne-Vorobjev potential of interaction.
1221 implicit real*8 (a-h,o-z)
1222 include 'DIMENSIONS'
1223 include "DIMENSIONS.COMPAR"
1224 include 'COMMON.CONTROL'
1225 include 'COMMON.GEO'
1226 include 'COMMON.VAR'
1227 include 'COMMON.LOCAL'
1228 include 'COMMON.CHAIN'
1229 include 'COMMON.DERIV'
1230 include 'COMMON.NAMES'
1231 include 'COMMON.INTERACT'
1232 include 'COMMON.IOUNITS'
1233 include 'COMMON.CALC'
1234 include 'COMMON.SBRIDGE'
1235 common /srutu/ icall
1241 c eneps_temp(j,i)=0.0d0
1246 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1249 c if (icall.gt.0) lprn=.true.
1251 do i=iatsc_s,iatsc_e
1252 itypi=iabs(itype(i))
1253 if (itypi.eq.ntyp1) cycle
1254 itypi1=iabs(itype(i+1))
1258 C returning the ith atom to box
1260 if (xi.lt.0) xi=xi+boxxsize
1262 if (yi.lt.0) yi=yi+boxysize
1264 if (zi.lt.0) zi=zi+boxzsize
1265 if ((zi.gt.bordlipbot)
1266 & .and.(zi.lt.bordliptop)) then
1267 C the energy transfer exist
1268 if (zi.lt.buflipbot) then
1269 C what fraction I am in
1271 & ((zi-bordlipbot)/lipbufthick)
1272 C lipbufthick is thickenes of lipid buffore
1273 sslipi=sscalelip(fracinbuf)
1274 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1275 elseif (zi.gt.bufliptop) then
1276 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1277 sslipi=sscalelip(fracinbuf)
1278 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1287 dxi=dc_norm(1,nres+i)
1288 dyi=dc_norm(2,nres+i)
1289 dzi=dc_norm(3,nres+i)
1290 dsci_inv=vbld_inv(i+nres)
1291 dxi=dc_norm(1,nres+i)
1292 dyi=dc_norm(2,nres+i)
1293 dzi=dc_norm(3,nres+i)
1294 dsci_inv=vbld_inv(i+nres)
1296 C Calculate SC interaction energy.
1298 do iint=1,nint_gr(i)
1299 do j=istart(i,iint),iend(i,iint)
1300 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1301 call dyn_ssbond_ene(i,j,evdwij)
1303 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1304 & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1305 C triple bond artifac removal
1306 do k=j+1,iend(i,iint)
1307 C search over all next residues
1308 if (dyn_ss_mask(k)) then
1309 C check if they are cysteins
1310 C write(iout,*) 'k=',k
1311 call triple_ssbond_ene(i,j,k,evdwij)
1312 C call the energy function that removes the artifical triple disulfide
1313 C bond the soubroutine is located in ssMD.F
1315 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1316 & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1317 endif!dyn_ss_mask(k)
1321 itypj=iabs(itype(j))
1322 if (itypj.eq.ntyp1) cycle
1323 dscj_inv=vbld_inv(j+nres)
1324 sig0ij=sigma(itypi,itypj)
1325 r0ij=r0(itypi,itypj)
1326 chi1=chi(itypi,itypj)
1327 chi2=chi(itypj,itypi)
1334 alf12=0.5D0*(alf1+alf2)
1335 C For diagnostics only!!!
1348 C returning jth atom to box
1350 if (xj.lt.0) xj=xj+boxxsize
1352 if (yj.lt.0) yj=yj+boxysize
1354 if (zj.lt.0) zj=zj+boxzsize
1355 if ((zj.gt.bordlipbot)
1356 & .and.(zj.lt.bordliptop)) then
1357 C the energy transfer exist
1358 if (zj.lt.buflipbot) then
1359 C what fraction I am in
1361 & ((zj-bordlipbot)/lipbufthick)
1362 C lipbufthick is thickenes of lipid buffore
1363 sslipj=sscalelip(fracinbuf)
1364 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1365 elseif (zj.gt.bufliptop) then
1366 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1367 sslipj=sscalelip(fracinbuf)
1368 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1377 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1378 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1379 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1380 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1381 C if (aa.ne.aa_aq(itypi,itypj)) then
1383 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1384 C & bb_aq(itypi,itypj)-bb,
1388 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1389 C checking the distance
1390 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1395 C finding the closest
1399 xj=xj_safe+xshift*boxxsize
1400 yj=yj_safe+yshift*boxysize
1401 zj=zj_safe+zshift*boxzsize
1402 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1403 if (dist_temp.lt.dist_init) then
1413 if (subchap.eq.1) then
1423 dxj=dc_norm(1,nres+j)
1424 dyj=dc_norm(2,nres+j)
1425 dzj=dc_norm(3,nres+j)
1426 c write (iout,*) i,j,xj,yj,zj
1427 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1429 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1430 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1431 if (sss.le.0.0) cycle
1432 C Calculate angle-dependent terms of energy and contributions to their
1437 sig=sig0ij*dsqrt(sigsq)
1438 rij_shift=1.0D0/rij-sig+r0ij
1439 C I hate to put IF's in the loops, but here don't have another choice!!!!
1440 if (rij_shift.le.0.0D0) then
1445 c---------------------------------------------------------------
1446 rij_shift=1.0D0/rij_shift
1447 fac=rij_shift**expon
1450 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1451 eps2der=evdwij*eps3rt
1452 eps3der=evdwij*eps2rt
1453 fac_augm=rrij**expon
1454 e_augm=augm(itypi,itypj)*fac_augm
1455 evdwij=evdwij*eps2rt*eps3rt
1457 evdw=evdw+evdwij*sss+e_augm
1459 evdw_t=evdw_t+evdwij*sss+e_augm
1461 c evdw=evdw+evdwij+e_augm
1462 ij=icant(itypi,itypj)
1463 aux=eps1*eps2rt**2*eps3rt**2
1464 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1465 c & /dabs(eps(itypi,itypj))
1466 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1467 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1468 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1469 c & aux*e2/eps(itypi,itypj)
1473 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1475 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1476 & restyp(itypi),i,restyp(itypj),j,
1477 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1478 & chi1,chi2,chip1,chip2,
1479 & eps1,eps2rt**2,eps3rt**2,
1480 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1482 write (iout,*) "partial sum", evdw, evdw_t
1486 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1489 C Calculate gradient components.
1490 e1=e1*eps1*eps2rt**2*eps3rt**2
1491 fac=-expon*(e1+evdwij)*rij_shift
1494 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1495 C Calculate the radial part of the gradient
1499 C Calculate angular part of the gradient.
1508 C-----------------------------------------------------------------------------
1509 subroutine sc_angular
1510 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1511 C om12. Called by ebp, egb, and egbv.
1513 include 'COMMON.CALC'
1517 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1518 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1519 om12=dxi*dxj+dyi*dyj+dzi*dzj
1521 C Calculate eps1(om12) and its derivative in om12
1522 faceps1=1.0D0-om12*chiom12
1523 faceps1_inv=1.0D0/faceps1
1524 eps1=dsqrt(faceps1_inv)
1525 C Following variable is eps1*deps1/dom12
1526 eps1_om12=faceps1_inv*chiom12
1527 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1532 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1533 sigsq=1.0D0-facsig*faceps1_inv
1534 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1535 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1536 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1537 C Calculate eps2 and its derivatives in om1, om2, and om12.
1540 chipom12=chip12*om12
1541 facp=1.0D0-om12*chipom12
1543 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1544 C Following variable is the square root of eps2
1545 eps2rt=1.0D0-facp1*facp_inv
1546 C Following three variables are the derivatives of the square root of eps
1547 C in om1, om2, and om12.
1548 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1549 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1550 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1551 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1552 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1553 C Calculate whole angle-dependent part of epsilon and contributions
1554 C to its derivatives
1557 C----------------------------------------------------------------------------
1559 implicit real*8 (a-h,o-z)
1560 include 'DIMENSIONS'
1561 include 'COMMON.CHAIN'
1562 include 'COMMON.DERIV'
1563 include 'COMMON.CALC'
1564 double precision dcosom1(3),dcosom2(3)
1565 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1566 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1567 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1568 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1570 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1571 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1574 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1577 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1578 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1579 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1580 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1581 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1582 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1585 C Calculate the components of the gradient in DC and X
1589 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1594 c------------------------------------------------------------------------------
1595 subroutine vec_and_deriv
1596 implicit real*8 (a-h,o-z)
1597 include 'DIMENSIONS'
1598 include 'COMMON.IOUNITS'
1599 include 'COMMON.GEO'
1600 include 'COMMON.VAR'
1601 include 'COMMON.LOCAL'
1602 include 'COMMON.CHAIN'
1603 include 'COMMON.VECTORS'
1604 include 'COMMON.DERIV'
1605 include 'COMMON.INTERACT'
1606 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1607 C Compute the local reference systems. For reference system (i), the
1608 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1609 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1611 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1612 if (i.eq.nres-1) then
1613 C Case of the last full residue
1614 C Compute the Z-axis
1615 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1616 costh=dcos(pi-theta(nres))
1617 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1618 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1624 C Compute the derivatives of uz
1626 uzder(2,1,1)=-dc_norm(3,i-1)
1627 uzder(3,1,1)= dc_norm(2,i-1)
1628 uzder(1,2,1)= dc_norm(3,i-1)
1630 uzder(3,2,1)=-dc_norm(1,i-1)
1631 uzder(1,3,1)=-dc_norm(2,i-1)
1632 uzder(2,3,1)= dc_norm(1,i-1)
1635 uzder(2,1,2)= dc_norm(3,i)
1636 uzder(3,1,2)=-dc_norm(2,i)
1637 uzder(1,2,2)=-dc_norm(3,i)
1639 uzder(3,2,2)= dc_norm(1,i)
1640 uzder(1,3,2)= dc_norm(2,i)
1641 uzder(2,3,2)=-dc_norm(1,i)
1644 C Compute the Y-axis
1647 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1650 C Compute the derivatives of uy
1653 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1654 & -dc_norm(k,i)*dc_norm(j,i-1)
1655 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1657 uyder(j,j,1)=uyder(j,j,1)-costh
1658 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1663 uygrad(l,k,j,i)=uyder(l,k,j)
1664 uzgrad(l,k,j,i)=uzder(l,k,j)
1668 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1669 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1670 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1671 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1675 C Compute the Z-axis
1676 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1677 costh=dcos(pi-theta(i+2))
1678 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1683 C Compute the derivatives of uz
1685 uzder(2,1,1)=-dc_norm(3,i+1)
1686 uzder(3,1,1)= dc_norm(2,i+1)
1687 uzder(1,2,1)= dc_norm(3,i+1)
1689 uzder(3,2,1)=-dc_norm(1,i+1)
1690 uzder(1,3,1)=-dc_norm(2,i+1)
1691 uzder(2,3,1)= dc_norm(1,i+1)
1694 uzder(2,1,2)= dc_norm(3,i)
1695 uzder(3,1,2)=-dc_norm(2,i)
1696 uzder(1,2,2)=-dc_norm(3,i)
1698 uzder(3,2,2)= dc_norm(1,i)
1699 uzder(1,3,2)= dc_norm(2,i)
1700 uzder(2,3,2)=-dc_norm(1,i)
1703 C Compute the Y-axis
1706 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1709 C Compute the derivatives of uy
1712 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1713 & -dc_norm(k,i)*dc_norm(j,i+1)
1714 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1716 uyder(j,j,1)=uyder(j,j,1)-costh
1717 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1722 uygrad(l,k,j,i)=uyder(l,k,j)
1723 uzgrad(l,k,j,i)=uzder(l,k,j)
1727 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1728 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1729 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1730 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1736 vbld_inv_temp(1)=vbld_inv(i+1)
1737 if (i.lt.nres-1) then
1738 vbld_inv_temp(2)=vbld_inv(i+2)
1740 vbld_inv_temp(2)=vbld_inv(i)
1745 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1746 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1754 C--------------------------------------------------------------------------
1755 subroutine set_matrices
1756 implicit real*8 (a-h,o-z)
1757 include 'DIMENSIONS'
1761 integer status(MPI_STATUS_SIZE)
1763 include 'COMMON.IOUNITS'
1764 include 'COMMON.GEO'
1765 include 'COMMON.VAR'
1766 include 'COMMON.LOCAL'
1767 include 'COMMON.CHAIN'
1768 include 'COMMON.DERIV'
1769 include 'COMMON.INTERACT'
1770 include 'COMMON.CONTACTS'
1771 include 'COMMON.TORSION'
1772 include 'COMMON.VECTORS'
1773 include 'COMMON.FFIELD'
1774 double precision auxvec(2),auxmat(2,2)
1776 C Compute the virtual-bond-torsional-angle dependent quantities needed
1777 C to calculate the el-loc multibody terms of various order.
1779 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1781 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1782 iti = itype2loc(itype(i-2))
1786 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1787 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1788 iti1 = itype2loc(itype(i-1))
1793 cost1=dcos(theta(i-1))
1794 sint1=dsin(theta(i-1))
1796 sint1cub=sint1sq*sint1
1797 sint1cost1=2*sint1*cost1
1799 write (iout,*) "bnew1",i,iti
1800 write (iout,*) (bnew1(k,1,iti),k=1,3)
1801 write (iout,*) (bnew1(k,2,iti),k=1,3)
1802 write (iout,*) "bnew2",i,iti
1803 write (iout,*) (bnew2(k,1,iti),k=1,3)
1804 write (iout,*) (bnew2(k,2,iti),k=1,3)
1807 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1809 gtb1(k,i-2)=cost1*b1k-sint1sq*
1810 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1811 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1813 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1814 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1817 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1818 cc(1,k,i-2)=sint1sq*aux
1819 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1820 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1821 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1822 dd(1,k,i-2)=sint1sq*aux
1823 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1824 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1826 cc(2,1,i-2)=cc(1,2,i-2)
1827 cc(2,2,i-2)=-cc(1,1,i-2)
1828 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1829 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1830 dd(2,1,i-2)=dd(1,2,i-2)
1831 dd(2,2,i-2)=-dd(1,1,i-2)
1832 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1833 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1836 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1837 EE(l,k,i-2)=sint1sq*aux
1839 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1842 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1843 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1844 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1845 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1847 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1848 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1849 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1851 c b1tilde(1,i-2)=b1(1,i-2)
1852 c b1tilde(2,i-2)=-b1(2,i-2)
1853 c b2tilde(1,i-2)=b2(1,i-2)
1854 c b2tilde(2,i-2)=-b2(2,i-2)
1856 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1857 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1858 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1859 write (iout,*) 'theta=', theta(i-1)
1862 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1863 c iti = itype2loc(itype(i-2))
1867 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1868 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1869 c iti1 = itype2loc(itype(i-1))
1879 CC(k,l,i-2)=ccold(k,l,iti)
1880 DD(k,l,i-2)=ddold(k,l,iti)
1881 EE(k,l,i-2)=eeold(k,l,iti)
1885 b1tilde(1,i-2)= b1(1,i-2)
1886 b1tilde(2,i-2)=-b1(2,i-2)
1887 b2tilde(1,i-2)= b2(1,i-2)
1888 b2tilde(2,i-2)=-b2(2,i-2)
1890 Ctilde(1,1,i-2)= CC(1,1,i-2)
1891 Ctilde(1,2,i-2)= CC(1,2,i-2)
1892 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1893 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1895 Dtilde(1,1,i-2)= DD(1,1,i-2)
1896 Dtilde(1,2,i-2)= DD(1,2,i-2)
1897 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1898 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1899 c write(iout,*) "i",i," iti",iti
1900 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1901 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1904 if (i .lt. nres+1) then
1941 if (i .gt. 3 .and. i .lt. nres+1) then
1942 obrot_der(1,i-2)=-sin1
1943 obrot_der(2,i-2)= cos1
1944 Ugder(1,1,i-2)= sin1
1945 Ugder(1,2,i-2)=-cos1
1946 Ugder(2,1,i-2)=-cos1
1947 Ugder(2,2,i-2)=-sin1
1950 obrot2_der(1,i-2)=-dwasin2
1951 obrot2_der(2,i-2)= dwacos2
1952 Ug2der(1,1,i-2)= dwasin2
1953 Ug2der(1,2,i-2)=-dwacos2
1954 Ug2der(2,1,i-2)=-dwacos2
1955 Ug2der(2,2,i-2)=-dwasin2
1957 obrot_der(1,i-2)=0.0d0
1958 obrot_der(2,i-2)=0.0d0
1959 Ugder(1,1,i-2)=0.0d0
1960 Ugder(1,2,i-2)=0.0d0
1961 Ugder(2,1,i-2)=0.0d0
1962 Ugder(2,2,i-2)=0.0d0
1963 obrot2_der(1,i-2)=0.0d0
1964 obrot2_der(2,i-2)=0.0d0
1965 Ug2der(1,1,i-2)=0.0d0
1966 Ug2der(1,2,i-2)=0.0d0
1967 Ug2der(2,1,i-2)=0.0d0
1968 Ug2der(2,2,i-2)=0.0d0
1970 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1971 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1972 iti = itype2loc(itype(i-2))
1976 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1977 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1978 iti1 = itype2loc(itype(i-1))
1982 cd write (iout,*) '*******i',i,' iti1',iti
1983 cd write (iout,*) 'b1',b1(:,iti)
1984 cd write (iout,*) 'b2',b2(:,iti)
1985 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1986 c if (i .gt. iatel_s+2) then
1987 if (i .gt. nnt+2) then
1988 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1990 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1991 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1993 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1994 c & EE(1,2,iti),EE(2,2,i)
1995 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1996 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1997 c write(iout,*) "Macierz EUG",
1998 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2000 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2002 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
2003 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
2004 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2005 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
2006 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
2017 DtUg2(l,k,i-2)=0.0d0
2021 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2022 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2024 muder(k,i-2)=Ub2der(k,i-2)
2026 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2027 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2028 if (itype(i-1).le.ntyp) then
2029 iti1 = itype2loc(itype(i-1))
2037 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2040 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2041 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2042 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2043 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2044 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2045 & ((ee(l,k,i-2),l=1,2),k=1,2)
2047 cd write (iout,*) 'mu1',mu1(:,i-2)
2048 cd write (iout,*) 'mu2',mu2(:,i-2)
2049 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2052 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2053 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2054 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2055 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2056 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2058 C Vectors and matrices dependent on a single virtual-bond dihedral.
2059 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2060 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2061 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2062 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2063 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2065 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2066 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2067 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2068 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2072 C Matrices dependent on two consecutive virtual-bond dihedrals.
2073 C The order of matrices is from left to right.
2074 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2077 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2079 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2080 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2082 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2083 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2085 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2086 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2087 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2093 C--------------------------------------------------------------------------
2094 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2096 C This subroutine calculates the average interaction energy and its gradient
2097 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2098 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2099 C The potential depends both on the distance of peptide-group centers and on
2100 C the orientation of the CA-CA virtual bonds.
2102 implicit real*8 (a-h,o-z)
2106 include 'DIMENSIONS'
2107 include 'COMMON.CONTROL'
2108 include 'COMMON.IOUNITS'
2109 include 'COMMON.GEO'
2110 include 'COMMON.VAR'
2111 include 'COMMON.LOCAL'
2112 include 'COMMON.CHAIN'
2113 include 'COMMON.DERIV'
2114 include 'COMMON.INTERACT'
2115 include 'COMMON.CONTACTS'
2116 include 'COMMON.TORSION'
2117 include 'COMMON.VECTORS'
2118 include 'COMMON.FFIELD'
2119 include 'COMMON.TIME1'
2120 include 'COMMON.SPLITELE'
2121 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2122 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2123 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2124 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2125 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2126 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2128 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2130 double precision scal_el /1.0d0/
2132 double precision scal_el /0.5d0/
2135 C 13-go grudnia roku pamietnego...
2136 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2137 & 0.0d0,1.0d0,0.0d0,
2138 & 0.0d0,0.0d0,1.0d0/
2139 cd write(iout,*) 'In EELEC'
2141 cd write(iout,*) 'Type',i
2142 cd write(iout,*) 'B1',B1(:,i)
2143 cd write(iout,*) 'B2',B2(:,i)
2144 cd write(iout,*) 'CC',CC(:,:,i)
2145 cd write(iout,*) 'DD',DD(:,:,i)
2146 cd write(iout,*) 'EE',EE(:,:,i)
2148 cd call check_vecgrad
2150 if (icheckgrad.eq.1) then
2152 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2154 dc_norm(k,i)=dc(k,i)*fac
2156 c write (iout,*) 'i',i,' fac',fac
2159 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2160 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2161 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2162 c call vec_and_deriv
2168 time_mat=time_mat+MPI_Wtime()-time01
2172 cd write (iout,*) 'i=',i
2174 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2177 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2178 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2191 cd print '(a)','Enter EELEC'
2192 c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2195 gel_loc_loc(i)=0.0d0
2200 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2202 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2204 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2205 do i=iturn3_start,iturn3_end
2207 C write(iout,*) "tu jest i",i
2208 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2209 C changes suggested by Ana to avoid out of bounds
2210 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2211 c & .or.((i+4).gt.nres)
2212 c & .or.((i-1).le.0)
2213 C end of changes by Ana
2214 C dobra zmiana wycofana
2215 & .or. itype(i+2).eq.ntyp1
2216 & .or. itype(i+3).eq.ntyp1) cycle
2217 C Adam: Instructions below will switch off existing interactions
2219 c if(itype(i-1).eq.ntyp1)cycle
2221 c if(i.LT.nres-3)then
2222 c if (itype(i+4).eq.ntyp1) cycle
2227 dx_normi=dc_norm(1,i)
2228 dy_normi=dc_norm(2,i)
2229 dz_normi=dc_norm(3,i)
2230 xmedi=c(1,i)+0.5d0*dxi
2231 ymedi=c(2,i)+0.5d0*dyi
2232 zmedi=c(3,i)+0.5d0*dzi
2233 xmedi=mod(xmedi,boxxsize)
2234 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2235 ymedi=mod(ymedi,boxysize)
2236 if (ymedi.lt.0) ymedi=ymedi+boxysize
2237 zmedi=mod(zmedi,boxzsize)
2238 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2240 call eelecij(i,i+2,ees,evdw1,eel_loc)
2241 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2242 num_cont_hb(i)=num_conti
2244 do i=iturn4_start,iturn4_end
2246 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2247 C changes suggested by Ana to avoid out of bounds
2248 c & .or.((i+5).gt.nres)
2249 c & .or.((i-1).le.0)
2250 C end of changes suggested by Ana
2251 & .or. itype(i+3).eq.ntyp1
2252 & .or. itype(i+4).eq.ntyp1
2253 c & .or. itype(i+5).eq.ntyp1
2254 c & .or. itype(i).eq.ntyp1
2255 c & .or. itype(i-1).eq.ntyp1
2260 dx_normi=dc_norm(1,i)
2261 dy_normi=dc_norm(2,i)
2262 dz_normi=dc_norm(3,i)
2263 xmedi=c(1,i)+0.5d0*dxi
2264 ymedi=c(2,i)+0.5d0*dyi
2265 zmedi=c(3,i)+0.5d0*dzi
2266 C Return atom into box, boxxsize is size of box in x dimension
2268 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2269 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2270 C Condition for being inside the proper box
2271 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2272 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2276 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2277 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2278 C Condition for being inside the proper box
2279 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2280 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2284 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2285 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2286 C Condition for being inside the proper box
2287 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2288 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2291 xmedi=mod(xmedi,boxxsize)
2292 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2293 ymedi=mod(ymedi,boxysize)
2294 if (ymedi.lt.0) ymedi=ymedi+boxysize
2295 zmedi=mod(zmedi,boxzsize)
2296 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2298 num_conti=num_cont_hb(i)
2299 c write(iout,*) "JESTEM W PETLI"
2300 call eelecij(i,i+3,ees,evdw1,eel_loc)
2301 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2302 & call eturn4(i,eello_turn4)
2303 num_cont_hb(i)=num_conti
2305 C Loop over all neighbouring boxes
2310 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2313 do i=iatel_s,iatel_e
2316 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2317 C changes suggested by Ana to avoid out of bounds
2318 c & .or.((i+2).gt.nres)
2319 c & .or.((i-1).le.0)
2320 C end of changes by Ana
2321 c & .or. itype(i+2).eq.ntyp1
2322 c & .or. itype(i-1).eq.ntyp1
2327 dx_normi=dc_norm(1,i)
2328 dy_normi=dc_norm(2,i)
2329 dz_normi=dc_norm(3,i)
2330 xmedi=c(1,i)+0.5d0*dxi
2331 ymedi=c(2,i)+0.5d0*dyi
2332 zmedi=c(3,i)+0.5d0*dzi
2333 xmedi=mod(xmedi,boxxsize)
2334 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2335 ymedi=mod(ymedi,boxysize)
2336 if (ymedi.lt.0) ymedi=ymedi+boxysize
2337 zmedi=mod(zmedi,boxzsize)
2338 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2339 C xmedi=xmedi+xshift*boxxsize
2340 C ymedi=ymedi+yshift*boxysize
2341 C zmedi=zmedi+zshift*boxzsize
2343 C Return tom into box, boxxsize is size of box in x dimension
2345 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2346 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2347 C Condition for being inside the proper box
2348 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2349 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2353 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2354 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2355 C Condition for being inside the proper box
2356 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2357 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2361 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2362 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2363 cC Condition for being inside the proper box
2364 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2365 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2369 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2370 num_conti=num_cont_hb(i)
2372 do j=ielstart(i),ielend(i)
2374 C write (iout,*) i,j
2376 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2377 C changes suggested by Ana to avoid out of bounds
2378 c & .or.((j+2).gt.nres)
2379 c & .or.((j-1).le.0)
2380 C end of changes by Ana
2381 c & .or.itype(j+2).eq.ntyp1
2382 c & .or.itype(j-1).eq.ntyp1
2384 call eelecij(i,j,ees,evdw1,eel_loc)
2386 num_cont_hb(i)=num_conti
2392 c write (iout,*) "Number of loop steps in EELEC:",ind
2394 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2395 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2397 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2398 ccc eel_loc=eel_loc+eello_turn3
2399 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2402 C-------------------------------------------------------------------------------
2403 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2404 implicit real*8 (a-h,o-z)
2405 include 'DIMENSIONS'
2409 include 'COMMON.CONTROL'
2410 include 'COMMON.IOUNITS'
2411 include 'COMMON.GEO'
2412 include 'COMMON.VAR'
2413 include 'COMMON.LOCAL'
2414 include 'COMMON.CHAIN'
2415 include 'COMMON.DERIV'
2416 include 'COMMON.INTERACT'
2417 include 'COMMON.CONTACTS'
2418 include 'COMMON.TORSION'
2419 include 'COMMON.VECTORS'
2420 include 'COMMON.FFIELD'
2421 include 'COMMON.TIME1'
2422 include 'COMMON.SPLITELE'
2423 include 'COMMON.SHIELD'
2424 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2425 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2426 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2427 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2428 & gmuij2(4),gmuji2(4)
2429 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2430 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2432 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2434 double precision scal_el /1.0d0/
2436 double precision scal_el /0.5d0/
2439 C 13-go grudnia roku pamietnego...
2440 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2441 & 0.0d0,1.0d0,0.0d0,
2442 & 0.0d0,0.0d0,1.0d0/
2443 integer xshift,yshift,zshift
2444 c time00=MPI_Wtime()
2445 cd write (iout,*) "eelecij",i,j
2449 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2450 aaa=app(iteli,itelj)
2451 bbb=bpp(iteli,itelj)
2452 ael6i=ael6(iteli,itelj)
2453 ael3i=ael3(iteli,itelj)
2457 dx_normj=dc_norm(1,j)
2458 dy_normj=dc_norm(2,j)
2459 dz_normj=dc_norm(3,j)
2460 C xj=c(1,j)+0.5D0*dxj-xmedi
2461 C yj=c(2,j)+0.5D0*dyj-ymedi
2462 C zj=c(3,j)+0.5D0*dzj-zmedi
2467 if (xj.lt.0) xj=xj+boxxsize
2469 if (yj.lt.0) yj=yj+boxysize
2471 if (zj.lt.0) zj=zj+boxzsize
2472 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2473 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2481 xj=xj_safe+xshift*boxxsize
2482 yj=yj_safe+yshift*boxysize
2483 zj=zj_safe+zshift*boxzsize
2484 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2485 if(dist_temp.lt.dist_init) then
2495 if (isubchap.eq.1) then
2504 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2506 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2507 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2508 C Condition for being inside the proper box
2509 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2510 c & (xj.lt.((-0.5d0)*boxxsize))) then
2514 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2515 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2516 C Condition for being inside the proper box
2517 c if ((yj.gt.((0.5d0)*boxysize)).or.
2518 c & (yj.lt.((-0.5d0)*boxysize))) then
2522 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2523 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2524 C Condition for being inside the proper box
2525 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2526 c & (zj.lt.((-0.5d0)*boxzsize))) then
2529 C endif !endPBC condintion
2533 rij=xj*xj+yj*yj+zj*zj
2535 sss=sscale(sqrt(rij))
2536 sssgrad=sscagrad(sqrt(rij))
2537 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2538 c & " rlamb",rlamb," sss",sss
2539 c if (sss.gt.0.0d0) then
2545 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2546 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2547 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2548 fac=cosa-3.0D0*cosb*cosg
2550 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2551 if (j.eq.i+2) ev1=scal_el*ev1
2556 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2560 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2561 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2562 if (shield_mode.gt.0) then
2565 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2566 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2575 evdw1=evdw1+evdwij*sss
2576 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2577 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2578 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2579 cd & xmedi,ymedi,zmedi,xj,yj,zj
2581 if (energy_dec) then
2582 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2584 &,iteli,itelj,aaa,evdw1,sss
2585 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2586 &fac_shield(i),fac_shield(j)
2590 C Calculate contributions to the Cartesian gradient.
2593 facvdw=-6*rrmij*(ev1+evdwij)*sss
2594 facel=-3*rrmij*(el1+eesij)
2601 * Radial derivatives. First process both termini of the fragment (i,j)
2607 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2608 & (shield_mode.gt.0)) then
2610 do ilist=1,ishield_list(i)
2611 iresshield=shield_list(ilist,i)
2613 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2615 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2617 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2618 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2619 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2620 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2621 C if (iresshield.gt.i) then
2622 C do ishi=i+1,iresshield-1
2623 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2624 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2628 C do ishi=iresshield,i
2629 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2630 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2636 do ilist=1,ishield_list(j)
2637 iresshield=shield_list(ilist,j)
2639 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2641 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2643 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2644 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2646 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2647 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2648 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2649 C if (iresshield.gt.j) then
2650 C do ishi=j+1,iresshield-1
2651 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2652 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2656 C do ishi=iresshield,j
2657 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2658 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2665 gshieldc(k,i)=gshieldc(k,i)+
2666 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2667 gshieldc(k,j)=gshieldc(k,j)+
2668 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2669 gshieldc(k,i-1)=gshieldc(k,i-1)+
2670 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2671 gshieldc(k,j-1)=gshieldc(k,j-1)+
2672 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2677 c ghalf=0.5D0*ggg(k)
2678 c gelc(k,i)=gelc(k,i)+ghalf
2679 c gelc(k,j)=gelc(k,j)+ghalf
2681 c 9/28/08 AL Gradient compotents will be summed only at the end
2682 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2684 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2685 C & +grad_shield(k,j)*eesij/fac_shield(j)
2686 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2687 C & +grad_shield(k,i)*eesij/fac_shield(i)
2688 C gelc_long(k,i-1)=gelc_long(k,i-1)
2689 C & +grad_shield(k,i)*eesij/fac_shield(i)
2690 C gelc_long(k,j-1)=gelc_long(k,j-1)
2691 C & +grad_shield(k,j)*eesij/fac_shield(j)
2693 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2696 * Loop over residues i+1 thru j-1.
2700 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2703 if (sss.gt.0.0) then
2704 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2705 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2706 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2713 c ghalf=0.5D0*ggg(k)
2714 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2715 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2717 c 9/28/08 AL Gradient compotents will be summed only at the end
2719 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2720 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2723 * Loop over residues i+1 thru j-1.
2727 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2733 facvdw=(ev1+evdwij)*sss
2736 fac=-3*rrmij*(facvdw+facvdw+facel)
2741 * Radial derivatives. First process both termini of the fragment (i,j)
2745 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2747 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2749 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2751 c ghalf=0.5D0*ggg(k)
2752 c gelc(k,i)=gelc(k,i)+ghalf
2753 c gelc(k,j)=gelc(k,j)+ghalf
2755 c 9/28/08 AL Gradient compotents will be summed only at the end
2757 gelc_long(k,j)=gelc(k,j)+ggg(k)
2758 gelc_long(k,i)=gelc(k,i)-ggg(k)
2761 * Loop over residues i+1 thru j-1.
2765 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2768 c 9/28/08 AL Gradient compotents will be summed only at the end
2769 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2770 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2771 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2773 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2774 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2782 ecosa=2.0D0*fac3*fac1+fac4
2785 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2786 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2788 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2789 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2791 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2792 cd & (dcosg(k),k=1,3)
2794 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2795 & fac_shield(i)**2*fac_shield(j)**2
2798 c ghalf=0.5D0*ggg(k)
2799 c gelc(k,i)=gelc(k,i)+ghalf
2800 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2801 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2802 c gelc(k,j)=gelc(k,j)+ghalf
2803 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2804 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2808 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2811 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2814 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2815 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2816 & *fac_shield(i)**2*fac_shield(j)**2
2818 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2819 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2820 & *fac_shield(i)**2*fac_shield(j)**2
2821 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2822 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2824 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2829 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2830 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2831 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2833 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2834 C energy of a peptide unit is assumed in the form of a second-order
2835 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2836 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2837 C are computed for EVERY pair of non-contiguous peptide groups.
2840 if (j.lt.nres-1) then
2852 muij(kkk)=mu(k,i)*mu(l,j)
2853 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2856 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2857 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2858 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2859 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2860 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2861 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2867 write (iout,*) 'EELEC: i',i,' j',j
2868 write (iout,*) 'j',j,' j1',j1,' j2',j2
2869 write(iout,*) 'muij',muij
2870 write (iout,*) "uy",uy(:,i)
2871 write (iout,*) "uz",uz(:,j)
2872 write (iout,*) "erij",erij
2874 ury=scalar(uy(1,i),erij)
2875 urz=scalar(uz(1,i),erij)
2876 vry=scalar(uy(1,j),erij)
2877 vrz=scalar(uz(1,j),erij)
2878 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2879 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2880 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2881 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2882 fac=dsqrt(-ael6i)*r3ij
2887 cd write (iout,'(4i5,4f10.5)')
2888 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2889 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2890 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2891 cd & uy(:,j),uz(:,j)
2892 cd write (iout,'(4f10.5)')
2893 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2894 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2895 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2896 cd write (iout,'(9f10.5/)')
2897 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2898 C Derivatives of the elements of A in virtual-bond vectors
2900 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2902 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2903 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2904 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2905 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2906 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2907 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2908 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2909 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2910 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2911 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2912 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2913 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2915 C Compute radial contributions to the gradient
2933 C Add the contributions coming from er
2936 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2937 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2938 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2939 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2942 C Derivatives in DC(i)
2943 cgrad ghalf1=0.5d0*agg(k,1)
2944 cgrad ghalf2=0.5d0*agg(k,2)
2945 cgrad ghalf3=0.5d0*agg(k,3)
2946 cgrad ghalf4=0.5d0*agg(k,4)
2947 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2948 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2949 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2950 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2951 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2952 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2953 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2954 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2955 C Derivatives in DC(i+1)
2956 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2957 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2958 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2959 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2960 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2961 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2962 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2963 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2964 C Derivatives in DC(j)
2965 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2966 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2967 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2968 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2969 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2970 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2971 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2972 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2973 C Derivatives in DC(j+1) or DC(nres-1)
2974 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2975 & -3.0d0*vryg(k,3)*ury)
2976 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2977 & -3.0d0*vrzg(k,3)*ury)
2978 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2979 & -3.0d0*vryg(k,3)*urz)
2980 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2981 & -3.0d0*vrzg(k,3)*urz)
2982 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2984 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2999 aggi(k,l)=-aggi(k,l)
3000 aggi1(k,l)=-aggi1(k,l)
3001 aggj(k,l)=-aggj(k,l)
3002 aggj1(k,l)=-aggj1(k,l)
3006 if (j.lt.nres-1) then
3012 aggi(k,l)=-aggi(k,l)
3013 aggi1(k,l)=-aggi1(k,l)
3014 aggj(k,l)=-aggj(k,l)
3015 aggj1(k,l)=-aggj1(k,l)
3026 aggi(k,l)=-aggi(k,l)
3027 aggi1(k,l)=-aggi1(k,l)
3028 aggj(k,l)=-aggj(k,l)
3029 aggj1(k,l)=-aggj1(k,l)
3034 IF (wel_loc.gt.0.0d0) THEN
3035 C Contribution to the local-electrostatic energy coming from the i-j pair
3036 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3039 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
3041 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
3042 & " wel_loc",wel_loc
3044 if (shield_mode.eq.0) then
3051 eel_loc_ij=eel_loc_ij
3052 & *fac_shield(i)*fac_shield(j)
3053 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3054 & 'eelloc',i,j,eel_loc_ij
3055 c if (eel_loc_ij.ne.0)
3056 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3057 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3059 eel_loc=eel_loc+eel_loc_ij
3060 C Now derivative over eel_loc
3062 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3063 & (shield_mode.gt.0)) then
3066 do ilist=1,ishield_list(i)
3067 iresshield=shield_list(ilist,i)
3069 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
3072 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3074 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
3075 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3079 do ilist=1,ishield_list(j)
3080 iresshield=shield_list(ilist,j)
3082 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
3085 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3087 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3088 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3095 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3096 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3097 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3098 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3099 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3100 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3101 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3102 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3107 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3108 c & ' eel_loc_ij',eel_loc_ij
3109 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3110 C Calculate patrial derivative for theta angle
3112 geel_loc_ij=(a22*gmuij1(1)
3116 & *fac_shield(i)*fac_shield(j)
3117 c write(iout,*) "derivative over thatai"
3118 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3120 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3121 & geel_loc_ij*wel_loc
3122 c write(iout,*) "derivative over thatai-1"
3123 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3130 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3131 & geel_loc_ij*wel_loc
3132 & *fac_shield(i)*fac_shield(j)
3134 c Derivative over j residue
3135 geel_loc_ji=a22*gmuji1(1)
3139 c write(iout,*) "derivative over thataj"
3140 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3143 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3144 & geel_loc_ji*wel_loc
3145 & *fac_shield(i)*fac_shield(j)
3152 c write(iout,*) "derivative over thataj-1"
3153 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3155 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3156 & geel_loc_ji*wel_loc
3157 & *fac_shield(i)*fac_shield(j)
3159 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3161 C Partial derivatives in virtual-bond dihedral angles gamma
3163 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3164 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3165 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3166 & *fac_shield(i)*fac_shield(j)
3168 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3169 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3170 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3171 & *fac_shield(i)*fac_shield(j)
3172 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3174 ggg(l)=(agg(l,1)*muij(1)+
3175 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3176 & *fac_shield(i)*fac_shield(j)
3177 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3178 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3179 cgrad ghalf=0.5d0*ggg(l)
3180 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3181 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3185 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3188 C Remaining derivatives of eello
3190 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3191 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3192 & *fac_shield(i)*fac_shield(j)
3194 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3195 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3196 & *fac_shield(i)*fac_shield(j)
3198 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3199 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3200 & *fac_shield(i)*fac_shield(j)
3202 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3203 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3204 & *fac_shield(i)*fac_shield(j)
3211 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3212 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3213 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3214 & .and. num_conti.le.maxconts) then
3215 c write (iout,*) i,j," entered corr"
3217 C Calculate the contact function. The ith column of the array JCONT will
3218 C contain the numbers of atoms that make contacts with the atom I (of numbers
3219 C greater than I). The arrays FACONT and GACONT will contain the values of
3220 C the contact function and its derivative.
3221 c r0ij=1.02D0*rpp(iteli,itelj)
3222 c r0ij=1.11D0*rpp(iteli,itelj)
3223 r0ij=2.20D0*rpp(iteli,itelj)
3224 c r0ij=1.55D0*rpp(iteli,itelj)
3225 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3226 if (fcont.gt.0.0D0) then
3227 num_conti=num_conti+1
3228 if (num_conti.gt.maxconts) then
3229 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3230 & ' will skip next contacts for this conf.'
3232 jcont_hb(num_conti,i)=j
3233 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3234 cd & " jcont_hb",jcont_hb(num_conti,i)
3235 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3236 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3237 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3239 d_cont(num_conti,i)=rij
3240 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3241 C --- Electrostatic-interaction matrix ---
3242 a_chuj(1,1,num_conti,i)=a22
3243 a_chuj(1,2,num_conti,i)=a23
3244 a_chuj(2,1,num_conti,i)=a32
3245 a_chuj(2,2,num_conti,i)=a33
3246 C --- Gradient of rij
3249 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3256 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3257 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3258 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3259 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3260 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3266 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3267 C Calculate contact energies
3269 wij=cosa-3.0D0*cosb*cosg
3272 c fac3=dsqrt(-ael6i)/r0ij**3
3273 fac3=dsqrt(-ael6i)*r3ij
3274 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3275 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3276 if (ees0tmp.gt.0) then
3277 ees0pij=dsqrt(ees0tmp)
3281 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3282 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3283 if (ees0tmp.gt.0) then
3284 ees0mij=dsqrt(ees0tmp)
3289 if (shield_mode.eq.0) then
3293 ees0plist(num_conti,i)=j
3294 C fac_shield(i)=0.4d0
3295 C fac_shield(j)=0.6d0
3297 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3298 & *fac_shield(i)*fac_shield(j)
3299 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3300 & *fac_shield(i)*fac_shield(j)
3301 C Diagnostics. Comment out or remove after debugging!
3302 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3303 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3304 c ees0m(num_conti,i)=0.0D0
3306 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3307 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3308 C Angular derivatives of the contact function
3310 ees0pij1=fac3/ees0pij
3311 ees0mij1=fac3/ees0mij
3312 fac3p=-3.0D0*fac3*rrmij
3313 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3314 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3316 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3317 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3318 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3319 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3320 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3321 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3322 ecosap=ecosa1+ecosa2
3323 ecosbp=ecosb1+ecosb2
3324 ecosgp=ecosg1+ecosg2
3325 ecosam=ecosa1-ecosa2
3326 ecosbm=ecosb1-ecosb2
3327 ecosgm=ecosg1-ecosg2
3336 facont_hb(num_conti,i)=fcont
3339 fprimcont=fprimcont/rij
3340 cd facont_hb(num_conti,i)=1.0D0
3341 C Following line is for diagnostics.
3344 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3345 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3348 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3349 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3351 gggp(1)=gggp(1)+ees0pijp*xj
3352 gggp(2)=gggp(2)+ees0pijp*yj
3353 gggp(3)=gggp(3)+ees0pijp*zj
3354 gggm(1)=gggm(1)+ees0mijp*xj
3355 gggm(2)=gggm(2)+ees0mijp*yj
3356 gggm(3)=gggm(3)+ees0mijp*zj
3357 C Derivatives due to the contact function
3358 gacont_hbr(1,num_conti,i)=fprimcont*xj
3359 gacont_hbr(2,num_conti,i)=fprimcont*yj
3360 gacont_hbr(3,num_conti,i)=fprimcont*zj
3363 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3364 c following the change of gradient-summation algorithm.
3366 cgrad ghalfp=0.5D0*gggp(k)
3367 cgrad ghalfm=0.5D0*gggm(k)
3368 gacontp_hb1(k,num_conti,i)=!ghalfp
3369 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3370 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3371 & *fac_shield(i)*fac_shield(j)
3373 gacontp_hb2(k,num_conti,i)=!ghalfp
3374 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3375 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3376 & *fac_shield(i)*fac_shield(j)
3378 gacontp_hb3(k,num_conti,i)=gggp(k)
3379 & *fac_shield(i)*fac_shield(j)
3381 gacontm_hb1(k,num_conti,i)=!ghalfm
3382 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3383 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3384 & *fac_shield(i)*fac_shield(j)
3386 gacontm_hb2(k,num_conti,i)=!ghalfm
3387 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3388 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3389 & *fac_shield(i)*fac_shield(j)
3391 gacontm_hb3(k,num_conti,i)=gggm(k)
3392 & *fac_shield(i)*fac_shield(j)
3395 C Diagnostics. Comment out or remove after debugging!
3397 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3398 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3399 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3400 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3401 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3402 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3408 endif ! num_conti.le.maxconts
3412 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3415 ghalf=0.5d0*agg(l,k)
3416 aggi(l,k)=aggi(l,k)+ghalf
3417 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3418 aggj(l,k)=aggj(l,k)+ghalf
3421 if (j.eq.nres-1 .and. i.lt.j-2) then
3424 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3430 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3433 C-----------------------------------------------------------------------------
3434 subroutine eturn3(i,eello_turn3)
3435 C Third- and fourth-order contributions from turns
3436 implicit real*8 (a-h,o-z)
3437 include 'DIMENSIONS'
3438 include 'COMMON.IOUNITS'
3439 include 'COMMON.GEO'
3440 include 'COMMON.VAR'
3441 include 'COMMON.LOCAL'
3442 include 'COMMON.CHAIN'
3443 include 'COMMON.DERIV'
3444 include 'COMMON.INTERACT'
3445 include 'COMMON.CONTACTS'
3446 include 'COMMON.TORSION'
3447 include 'COMMON.VECTORS'
3448 include 'COMMON.FFIELD'
3449 include 'COMMON.CONTROL'
3450 include 'COMMON.SHIELD'
3452 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3453 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3454 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3455 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3456 & auxgmat2(2,2),auxgmatt2(2,2)
3457 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3458 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3459 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3460 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3463 c write (iout,*) "eturn3",i,j,j1,j2
3468 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3470 C Third-order contributions
3477 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3478 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3479 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3480 c auxalary matices for theta gradient
3481 c auxalary matrix for i+1 and constant i+2
3482 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3483 c auxalary matrix for i+2 and constant i+1
3484 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3485 call transpose2(auxmat(1,1),auxmat1(1,1))
3486 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3487 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3488 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3489 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3490 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3491 if (shield_mode.eq.0) then
3498 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3499 & *fac_shield(i)*fac_shield(j)
3500 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3501 & *fac_shield(i)*fac_shield(j)
3502 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3506 C Derivatives in theta
3507 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3508 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3509 & *fac_shield(i)*fac_shield(j)
3510 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3511 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3512 & *fac_shield(i)*fac_shield(j)
3515 C Derivatives in shield mode
3516 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3517 & (shield_mode.gt.0)) then
3520 do ilist=1,ishield_list(i)
3521 iresshield=shield_list(ilist,i)
3523 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3525 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3527 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3528 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3532 do ilist=1,ishield_list(j)
3533 iresshield=shield_list(ilist,j)
3535 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3537 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3539 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3540 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3547 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3548 & grad_shield(k,i)*eello_t3/fac_shield(i)
3549 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3550 & grad_shield(k,j)*eello_t3/fac_shield(j)
3551 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3552 & grad_shield(k,i)*eello_t3/fac_shield(i)
3553 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3554 & grad_shield(k,j)*eello_t3/fac_shield(j)
3558 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3559 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3560 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3561 cd & ' eello_turn3_num',4*eello_turn3_num
3562 C Derivatives in gamma(i)
3563 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3564 call transpose2(auxmat2(1,1),auxmat3(1,1))
3565 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3566 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3567 & *fac_shield(i)*fac_shield(j)
3568 C Derivatives in gamma(i+1)
3569 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3570 call transpose2(auxmat2(1,1),auxmat3(1,1))
3571 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3572 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3573 & +0.5d0*(pizda(1,1)+pizda(2,2))
3574 & *fac_shield(i)*fac_shield(j)
3575 C Cartesian derivatives
3577 c ghalf1=0.5d0*agg(l,1)
3578 c ghalf2=0.5d0*agg(l,2)
3579 c ghalf3=0.5d0*agg(l,3)
3580 c ghalf4=0.5d0*agg(l,4)
3581 a_temp(1,1)=aggi(l,1)!+ghalf1
3582 a_temp(1,2)=aggi(l,2)!+ghalf2
3583 a_temp(2,1)=aggi(l,3)!+ghalf3
3584 a_temp(2,2)=aggi(l,4)!+ghalf4
3585 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3586 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3587 & +0.5d0*(pizda(1,1)+pizda(2,2))
3588 & *fac_shield(i)*fac_shield(j)
3590 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3591 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3592 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3593 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3594 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3595 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3596 & +0.5d0*(pizda(1,1)+pizda(2,2))
3597 & *fac_shield(i)*fac_shield(j)
3598 a_temp(1,1)=aggj(l,1)!+ghalf1
3599 a_temp(1,2)=aggj(l,2)!+ghalf2
3600 a_temp(2,1)=aggj(l,3)!+ghalf3
3601 a_temp(2,2)=aggj(l,4)!+ghalf4
3602 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3603 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3604 & +0.5d0*(pizda(1,1)+pizda(2,2))
3605 & *fac_shield(i)*fac_shield(j)
3606 a_temp(1,1)=aggj1(l,1)
3607 a_temp(1,2)=aggj1(l,2)
3608 a_temp(2,1)=aggj1(l,3)
3609 a_temp(2,2)=aggj1(l,4)
3610 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3611 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3612 & +0.5d0*(pizda(1,1)+pizda(2,2))
3613 & *fac_shield(i)*fac_shield(j)
3620 C-------------------------------------------------------------------------------
3621 subroutine eturn4(i,eello_turn4)
3622 C Third- and fourth-order contributions from turns
3623 implicit real*8 (a-h,o-z)
3624 include 'DIMENSIONS'
3625 include 'COMMON.IOUNITS'
3626 include 'COMMON.GEO'
3627 include 'COMMON.VAR'
3628 include 'COMMON.LOCAL'
3629 include 'COMMON.CHAIN'
3630 include 'COMMON.DERIV'
3631 include 'COMMON.INTERACT'
3632 include 'COMMON.CONTACTS'
3633 include 'COMMON.TORSION'
3634 include 'COMMON.VECTORS'
3635 include 'COMMON.FFIELD'
3636 include 'COMMON.CONTROL'
3637 include 'COMMON.SHIELD'
3639 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3640 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3641 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3642 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3643 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3644 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3645 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3646 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3647 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3648 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3649 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3652 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3654 C Fourth-order contributions
3662 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3663 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3664 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3665 c write(iout,*)"WCHODZE W PROGRAM"
3670 iti1=itype2loc(itype(i+1))
3671 iti2=itype2loc(itype(i+2))
3672 iti3=itype2loc(itype(i+3))
3673 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3674 call transpose2(EUg(1,1,i+1),e1t(1,1))
3675 call transpose2(Eug(1,1,i+2),e2t(1,1))
3676 call transpose2(Eug(1,1,i+3),e3t(1,1))
3677 C Ematrix derivative in theta
3678 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3679 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3680 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3681 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3682 c eta1 in derivative theta
3683 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3684 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3685 c auxgvec is derivative of Ub2 so i+3 theta
3686 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3687 c auxalary matrix of E i+1
3688 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3691 s1=scalar2(b1(1,i+2),auxvec(1))
3692 c derivative of theta i+2 with constant i+3
3693 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3694 c derivative of theta i+2 with constant i+2
3695 gs32=scalar2(b1(1,i+2),auxgvec(1))
3696 c derivative of E matix in theta of i+1
3697 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3699 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3700 c ea31 in derivative theta
3701 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3702 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3703 c auxilary matrix auxgvec of Ub2 with constant E matirx
3704 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3705 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3706 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3710 s2=scalar2(b1(1,i+1),auxvec(1))
3711 c derivative of theta i+1 with constant i+3
3712 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3713 c derivative of theta i+2 with constant i+1
3714 gs21=scalar2(b1(1,i+1),auxgvec(1))
3715 c derivative of theta i+3 with constant i+1
3716 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3717 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3719 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3720 c two derivatives over diffetent matrices
3721 c gtae3e2 is derivative over i+3
3722 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3723 c ae3gte2 is derivative over i+2
3724 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3725 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3726 c three possible derivative over theta E matices
3728 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3730 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3732 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3733 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3735 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3736 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3737 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3738 if (shield_mode.eq.0) then
3745 eello_turn4=eello_turn4-(s1+s2+s3)
3746 & *fac_shield(i)*fac_shield(j)
3747 eello_t4=-(s1+s2+s3)
3748 & *fac_shield(i)*fac_shield(j)
3749 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3750 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3751 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3752 C Now derivative over shield:
3753 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3754 & (shield_mode.gt.0)) then
3757 do ilist=1,ishield_list(i)
3758 iresshield=shield_list(ilist,i)
3760 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3762 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3764 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3765 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3769 do ilist=1,ishield_list(j)
3770 iresshield=shield_list(ilist,j)
3772 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3774 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3776 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3777 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3784 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3785 & grad_shield(k,i)*eello_t4/fac_shield(i)
3786 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3787 & grad_shield(k,j)*eello_t4/fac_shield(j)
3788 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3789 & grad_shield(k,i)*eello_t4/fac_shield(i)
3790 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3791 & grad_shield(k,j)*eello_t4/fac_shield(j)
3794 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3795 cd & ' eello_turn4_num',8*eello_turn4_num
3797 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3798 & -(gs13+gsE13+gsEE1)*wturn4
3799 & *fac_shield(i)*fac_shield(j)
3800 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3801 & -(gs23+gs21+gsEE2)*wturn4
3802 & *fac_shield(i)*fac_shield(j)
3804 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3805 & -(gs32+gsE31+gsEE3)*wturn4
3806 & *fac_shield(i)*fac_shield(j)
3808 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3811 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3812 & 'eturn4',i,j,-(s1+s2+s3)
3813 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3814 c & ' eello_turn4_num',8*eello_turn4_num
3815 C Derivatives in gamma(i)
3816 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3817 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3818 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3819 s1=scalar2(b1(1,i+2),auxvec(1))
3820 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3821 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3822 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3823 & *fac_shield(i)*fac_shield(j)
3824 C Derivatives in gamma(i+1)
3825 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3826 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3827 s2=scalar2(b1(1,i+1),auxvec(1))
3828 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3829 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3830 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3831 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3832 & *fac_shield(i)*fac_shield(j)
3833 C Derivatives in gamma(i+2)
3834 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3835 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3836 s1=scalar2(b1(1,i+2),auxvec(1))
3837 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3838 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3839 s2=scalar2(b1(1,i+1),auxvec(1))
3840 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3841 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3842 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3843 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3844 & *fac_shield(i)*fac_shield(j)
3846 C Cartesian derivatives
3847 C Derivatives of this turn contributions in DC(i+2)
3848 if (j.lt.nres-1) then
3850 a_temp(1,1)=agg(l,1)
3851 a_temp(1,2)=agg(l,2)
3852 a_temp(2,1)=agg(l,3)
3853 a_temp(2,2)=agg(l,4)
3854 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3855 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3856 s1=scalar2(b1(1,i+2),auxvec(1))
3857 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3858 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3859 s2=scalar2(b1(1,i+1),auxvec(1))
3860 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3861 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3862 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3864 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3865 & *fac_shield(i)*fac_shield(j)
3868 C Remaining derivatives of this turn contribution
3870 a_temp(1,1)=aggi(l,1)
3871 a_temp(1,2)=aggi(l,2)
3872 a_temp(2,1)=aggi(l,3)
3873 a_temp(2,2)=aggi(l,4)
3874 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3875 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3876 s1=scalar2(b1(1,i+2),auxvec(1))
3877 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3878 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3879 s2=scalar2(b1(1,i+1),auxvec(1))
3880 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3881 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3882 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3883 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3884 & *fac_shield(i)*fac_shield(j)
3885 a_temp(1,1)=aggi1(l,1)
3886 a_temp(1,2)=aggi1(l,2)
3887 a_temp(2,1)=aggi1(l,3)
3888 a_temp(2,2)=aggi1(l,4)
3889 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3890 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3891 s1=scalar2(b1(1,i+2),auxvec(1))
3892 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3893 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3894 s2=scalar2(b1(1,i+1),auxvec(1))
3895 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3896 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3897 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3898 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3899 & *fac_shield(i)*fac_shield(j)
3900 a_temp(1,1)=aggj(l,1)
3901 a_temp(1,2)=aggj(l,2)
3902 a_temp(2,1)=aggj(l,3)
3903 a_temp(2,2)=aggj(l,4)
3904 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3905 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3906 s1=scalar2(b1(1,i+2),auxvec(1))
3907 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3908 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3909 s2=scalar2(b1(1,i+1),auxvec(1))
3910 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3911 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3912 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3913 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3914 & *fac_shield(i)*fac_shield(j)
3915 a_temp(1,1)=aggj1(l,1)
3916 a_temp(1,2)=aggj1(l,2)
3917 a_temp(2,1)=aggj1(l,3)
3918 a_temp(2,2)=aggj1(l,4)
3919 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3920 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3921 s1=scalar2(b1(1,i+2),auxvec(1))
3922 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3923 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3924 s2=scalar2(b1(1,i+1),auxvec(1))
3925 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3926 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3927 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3928 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3929 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3930 & *fac_shield(i)*fac_shield(j)
3937 C-----------------------------------------------------------------------------
3938 subroutine vecpr(u,v,w)
3939 implicit real*8(a-h,o-z)
3940 dimension u(3),v(3),w(3)
3941 w(1)=u(2)*v(3)-u(3)*v(2)
3942 w(2)=-u(1)*v(3)+u(3)*v(1)
3943 w(3)=u(1)*v(2)-u(2)*v(1)
3946 C-----------------------------------------------------------------------------
3947 subroutine unormderiv(u,ugrad,unorm,ungrad)
3948 C This subroutine computes the derivatives of a normalized vector u, given
3949 C the derivatives computed without normalization conditions, ugrad. Returns
3952 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3953 double precision vec(3)
3954 double precision scalar
3956 c write (2,*) 'ugrad',ugrad
3959 vec(i)=scalar(ugrad(1,i),u(1))
3961 c write (2,*) 'vec',vec
3964 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3967 c write (2,*) 'ungrad',ungrad
3970 C-----------------------------------------------------------------------------
3971 subroutine escp(evdw2,evdw2_14)
3973 C This subroutine calculates the excluded-volume interaction energy between
3974 C peptide-group centers and side chains and its gradient in virtual-bond and
3975 C side-chain vectors.
3977 implicit real*8 (a-h,o-z)
3978 include 'DIMENSIONS'
3979 include 'COMMON.GEO'
3980 include 'COMMON.VAR'
3981 include 'COMMON.LOCAL'
3982 include 'COMMON.CHAIN'
3983 include 'COMMON.DERIV'
3984 include 'COMMON.INTERACT'
3985 include 'COMMON.FFIELD'
3986 include 'COMMON.IOUNITS'
3990 cd print '(a)','Enter ESCP'
3991 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3992 c & ' scal14',scal14
3993 do i=iatscp_s,iatscp_e
3994 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3996 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3997 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3998 if (iteli.eq.0) goto 1225
3999 xi=0.5D0*(c(1,i)+c(1,i+1))
4000 yi=0.5D0*(c(2,i)+c(2,i+1))
4001 zi=0.5D0*(c(3,i)+c(3,i+1))
4002 C Returning the ith atom to box
4004 if (xi.lt.0) xi=xi+boxxsize
4006 if (yi.lt.0) yi=yi+boxysize
4008 if (zi.lt.0) zi=zi+boxzsize
4009 do iint=1,nscp_gr(i)
4011 do j=iscpstart(i,iint),iscpend(i,iint)
4012 itypj=iabs(itype(j))
4013 if (itypj.eq.ntyp1) cycle
4014 C Uncomment following three lines for SC-p interactions
4018 C Uncomment following three lines for Ca-p interactions
4022 C returning the jth atom to box
4024 if (xj.lt.0) xj=xj+boxxsize
4026 if (yj.lt.0) yj=yj+boxysize
4028 if (zj.lt.0) zj=zj+boxzsize
4029 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4034 C Finding the closest jth atom
4038 xj=xj_safe+xshift*boxxsize
4039 yj=yj_safe+yshift*boxysize
4040 zj=zj_safe+zshift*boxzsize
4041 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4042 if(dist_temp.lt.dist_init) then
4052 if (subchap.eq.1) then
4061 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4062 C sss is scaling function for smoothing the cutoff gradient otherwise
4063 C the gradient would not be continuouse
4064 sss=sscale(1.0d0/(dsqrt(rrij)))
4065 if (sss.le.0.0d0) cycle
4066 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4068 e1=fac*fac*aad(itypj,iteli)
4069 e2=fac*bad(itypj,iteli)
4070 if (iabs(j-i) .le. 2) then
4073 evdw2_14=evdw2_14+(e1+e2)*sss
4076 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4077 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4078 c & bad(itypj,iteli)
4079 evdw2=evdw2+evdwij*sss
4082 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4084 fac=-(evdwij+e1)*rrij*sss
4085 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4090 cd write (iout,*) 'j<i'
4091 C Uncomment following three lines for SC-p interactions
4093 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4096 cd write (iout,*) 'j>i'
4099 C Uncomment following line for SC-p interactions
4100 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4104 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4108 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4109 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4112 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4122 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4123 gradx_scp(j,i)=expon*gradx_scp(j,i)
4126 C******************************************************************************
4130 C To save time the factor EXPON has been extracted from ALL components
4131 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4134 C******************************************************************************
4137 C--------------------------------------------------------------------------
4138 subroutine edis(ehpb)
4140 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4142 implicit real*8 (a-h,o-z)
4143 include 'DIMENSIONS'
4144 include 'COMMON.SBRIDGE'
4145 include 'COMMON.CHAIN'
4146 include 'COMMON.DERIV'
4147 include 'COMMON.VAR'
4148 include 'COMMON.INTERACT'
4149 include 'COMMON.CONTROL'
4150 include 'COMMON.IOUNITS'
4153 c write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4154 c write(iout,*)'link_start=',link_start,' link_end=',link_end
4155 C write(iout,*) link_end, "link_end"
4156 if (link_end.eq.0) return
4157 do i=link_start,link_end
4158 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4159 C CA-CA distance used in regularization of structure.
4162 C iii and jjj point to the residues for which the distance is assigned.
4163 if (ii.gt.nres) then
4170 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4171 C distance and angle dependent SS bond potential.
4172 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4173 C & iabs(itype(jjj)).eq.1) then
4174 C write(iout,*) constr_dist,"const"
4175 if (.not.dyn_ss .and. i.le.nss) then
4176 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4177 & iabs(itype(jjj)).eq.1) then
4178 call ssbond_ene(iii,jjj,eij)
4181 else if (ii.gt.nres .and. jj.gt.nres) then
4182 c Restraints from contact prediction
4184 if (constr_dist.eq.11) then
4185 C ehpb=ehpb+fordepth(i)**4.0d0
4186 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4187 ehpb=ehpb+fordepth(i)!**4.0d0
4188 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4189 fac=fordepth(i)!**4.0d0
4190 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4191 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4192 C & ehpb,fordepth(i),dd
4193 C write(iout,*) ehpb,"atu?"
4195 C fac=fordepth(i)**4.0d0
4196 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4198 if (dhpb1(i).gt.0.0d0) then
4199 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4200 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4201 c write (iout,*) "beta nmr",
4202 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4206 C Get the force constant corresponding to this distance.
4208 C Calculate the contribution to energy.
4209 ehpb=ehpb+waga*rdis*rdis
4210 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4212 C Evaluate gradient.
4215 endif !end dhpb1(i).gt.0
4216 endif !end const_dist=11
4218 ggg(j)=fac*(c(j,jj)-c(j,ii))
4221 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4222 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4225 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4226 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4229 C write(iout,*) "before"
4231 C write(iout,*) "after",dd
4232 if (constr_dist.eq.11) then
4233 ehpb=ehpb+fordepth(i)!**4.0d0
4234 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4235 fac=fordepth(i)!**4.0d0
4236 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4237 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
4238 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
4239 C print *,ehpb,"tu?"
4240 C write(iout,*) ehpb,"btu?",
4241 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
4242 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4243 C & ehpb,fordepth(i),dd
4245 if (dhpb1(i).gt.0.0d0) then
4246 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4247 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4248 c write (iout,*) "alph nmr",
4249 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4252 C Get the force constant corresponding to this distance.
4254 C Calculate the contribution to energy.
4255 ehpb=ehpb+waga*rdis*rdis
4256 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4258 C Evaluate gradient.
4265 ggg(j)=fac*(c(j,jj)-c(j,ii))
4267 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4268 C If this is a SC-SC distance, we need to calculate the contributions to the
4269 C Cartesian gradient in the SC vectors (ghpbx).
4272 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4273 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4278 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4283 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4286 C--------------------------------------------------------------------------
4287 subroutine ssbond_ene(i,j,eij)
4289 C Calculate the distance and angle dependent SS-bond potential energy
4290 C using a free-energy function derived based on RHF/6-31G** ab initio
4291 C calculations of diethyl disulfide.
4293 C A. Liwo and U. Kozlowska, 11/24/03
4295 implicit real*8 (a-h,o-z)
4296 include 'DIMENSIONS'
4297 include 'COMMON.SBRIDGE'
4298 include 'COMMON.CHAIN'
4299 include 'COMMON.DERIV'
4300 include 'COMMON.LOCAL'
4301 include 'COMMON.INTERACT'
4302 include 'COMMON.VAR'
4303 include 'COMMON.IOUNITS'
4304 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4305 itypi=iabs(itype(i))
4309 dxi=dc_norm(1,nres+i)
4310 dyi=dc_norm(2,nres+i)
4311 dzi=dc_norm(3,nres+i)
4312 dsci_inv=dsc_inv(itypi)
4313 itypj=iabs(itype(j))
4314 dscj_inv=dsc_inv(itypj)
4318 dxj=dc_norm(1,nres+j)
4319 dyj=dc_norm(2,nres+j)
4320 dzj=dc_norm(3,nres+j)
4321 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4326 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4327 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4328 om12=dxi*dxj+dyi*dyj+dzi*dzj
4330 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4331 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4337 deltat12=om2-om1+2.0d0
4339 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4340 & +akct*deltad*deltat12
4341 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4342 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4343 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4344 c & " deltat12",deltat12," eij",eij
4345 ed=2*akcm*deltad+akct*deltat12
4347 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4348 eom1=-2*akth*deltat1-pom1-om2*pom2
4349 eom2= 2*akth*deltat2+pom1-om1*pom2
4352 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4355 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4356 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4357 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4358 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4361 C Calculate the components of the gradient in DC and X
4365 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4370 C--------------------------------------------------------------------------
4371 subroutine ebond(estr)
4373 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4375 implicit real*8 (a-h,o-z)
4376 include 'DIMENSIONS'
4377 include 'COMMON.LOCAL'
4378 include 'COMMON.GEO'
4379 include 'COMMON.INTERACT'
4380 include 'COMMON.DERIV'
4381 include 'COMMON.VAR'
4382 include 'COMMON.CHAIN'
4383 include 'COMMON.IOUNITS'
4384 include 'COMMON.NAMES'
4385 include 'COMMON.FFIELD'
4386 include 'COMMON.CONTROL'
4387 double precision u(3),ud(3)
4390 c write (iout,*) "distchainmax",distchainmax
4392 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4393 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4395 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4396 C & *dc(j,i-1)/vbld(i)
4398 C if (energy_dec) write(iout,*)
4399 C & "estr1",i,vbld(i),distchainmax,
4400 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4402 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4403 diff = vbld(i)-vbldpDUM
4404 C write(iout,*) i,diff
4406 diff = vbld(i)-vbldp0
4407 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4411 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4414 C write (iout,'(a7,i5,4f7.3)')
4415 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4417 estr=0.5d0*AKP*estr+estr1
4419 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4423 if (iti.ne.10 .and. iti.ne.ntyp1) then
4426 diff=vbld(i+nres)-vbldsc0(1,iti)
4427 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4428 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4429 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4431 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4435 diff=vbld(i+nres)-vbldsc0(j,iti)
4436 ud(j)=aksc(j,iti)*diff
4437 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4451 uprod2=uprod2*u(k)*u(k)
4455 usumsqder=usumsqder+ud(j)*uprod2
4457 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4458 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4459 estr=estr+uprod/usum
4461 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4469 C--------------------------------------------------------------------------
4470 subroutine ebend(etheta,ethetacnstr)
4472 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4473 C angles gamma and its derivatives in consecutive thetas and gammas.
4475 implicit real*8 (a-h,o-z)
4476 include 'DIMENSIONS'
4477 include 'COMMON.LOCAL'
4478 include 'COMMON.GEO'
4479 include 'COMMON.INTERACT'
4480 include 'COMMON.DERIV'
4481 include 'COMMON.VAR'
4482 include 'COMMON.CHAIN'
4483 include 'COMMON.IOUNITS'
4484 include 'COMMON.NAMES'
4485 include 'COMMON.FFIELD'
4486 include 'COMMON.TORCNSTR'
4487 common /calcthet/ term1,term2,termm,diffak,ratak,
4488 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4489 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4490 double precision y(2),z(2)
4492 c time11=dexp(-2*time)
4495 c write (iout,*) "nres",nres
4496 c write (*,'(a,i2)') 'EBEND ICG=',icg
4497 c write (iout,*) ithet_start,ithet_end
4498 do i=ithet_start,ithet_end
4499 C if (itype(i-1).eq.ntyp1) cycle
4501 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4502 & .or.itype(i).eq.ntyp1) cycle
4503 C Zero the energy function and its derivative at 0 or pi.
4504 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4506 ichir1=isign(1,itype(i-2))
4507 ichir2=isign(1,itype(i))
4508 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4509 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4510 if (itype(i-1).eq.10) then
4511 itype1=isign(10,itype(i-2))
4512 ichir11=isign(1,itype(i-2))
4513 ichir12=isign(1,itype(i-2))
4514 itype2=isign(10,itype(i))
4515 ichir21=isign(1,itype(i))
4516 ichir22=isign(1,itype(i))
4523 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4527 c call proc_proc(phii,icrc)
4528 if (icrc.eq.1) phii=150.0
4539 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4543 c call proc_proc(phii1,icrc)
4544 if (icrc.eq.1) phii1=150.0
4556 C Calculate the "mean" value of theta from the part of the distribution
4557 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4558 C In following comments this theta will be referred to as t_c.
4559 thet_pred_mean=0.0d0
4561 athetk=athet(k,it,ichir1,ichir2)
4562 bthetk=bthet(k,it,ichir1,ichir2)
4564 athetk=athet(k,itype1,ichir11,ichir12)
4565 bthetk=bthet(k,itype2,ichir21,ichir22)
4567 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4569 c write (iout,*) "thet_pred_mean",thet_pred_mean
4570 dthett=thet_pred_mean*ssd
4571 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4572 c write (iout,*) "thet_pred_mean",thet_pred_mean
4573 C Derivatives of the "mean" values in gamma1 and gamma2.
4574 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4575 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4576 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4577 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4579 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4580 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4581 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4582 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4584 if (theta(i).gt.pi-delta) then
4585 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4587 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4588 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4589 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4591 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4593 else if (theta(i).lt.delta) then
4594 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4595 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4596 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4598 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4599 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4602 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4605 etheta=etheta+ethetai
4606 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4607 c & 'ebend',i,ethetai,theta(i),itype(i)
4608 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4609 c & rad2deg*phii,rad2deg*phii1,ethetai
4610 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4611 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4612 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4616 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4617 do i=1,ntheta_constr
4618 itheta=itheta_constr(i)
4619 thetiii=theta(itheta)
4620 difi=pinorm(thetiii-theta_constr0(i))
4621 if (difi.gt.theta_drange(i)) then
4622 difi=difi-theta_drange(i)
4623 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4624 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4625 & +for_thet_constr(i)*difi**3
4626 else if (difi.lt.-drange(i)) then
4628 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4629 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4630 & +for_thet_constr(i)*difi**3
4634 C if (energy_dec) then
4635 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4636 C & i,itheta,rad2deg*thetiii,
4637 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4638 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4639 C & gloc(itheta+nphi-2,icg)
4642 C Ufff.... We've done all this!!!
4645 C---------------------------------------------------------------------------
4646 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4648 implicit real*8 (a-h,o-z)
4649 include 'DIMENSIONS'
4650 include 'COMMON.LOCAL'
4651 include 'COMMON.IOUNITS'
4652 common /calcthet/ term1,term2,termm,diffak,ratak,
4653 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4654 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4655 C Calculate the contributions to both Gaussian lobes.
4656 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4657 C The "polynomial part" of the "standard deviation" of this part of
4661 sig=sig*thet_pred_mean+polthet(j,it)
4663 C Derivative of the "interior part" of the "standard deviation of the"
4664 C gamma-dependent Gaussian lobe in t_c.
4665 sigtc=3*polthet(3,it)
4667 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4670 C Set the parameters of both Gaussian lobes of the distribution.
4671 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4672 fac=sig*sig+sigc0(it)
4675 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4676 sigsqtc=-4.0D0*sigcsq*sigtc
4677 c print *,i,sig,sigtc,sigsqtc
4678 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4679 sigtc=-sigtc/(fac*fac)
4680 C Following variable is sigma(t_c)**(-2)
4681 sigcsq=sigcsq*sigcsq
4683 sig0inv=1.0D0/sig0i**2
4684 delthec=thetai-thet_pred_mean
4685 delthe0=thetai-theta0i
4686 term1=-0.5D0*sigcsq*delthec*delthec
4687 term2=-0.5D0*sig0inv*delthe0*delthe0
4688 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4689 C NaNs in taking the logarithm. We extract the largest exponent which is added
4690 C to the energy (this being the log of the distribution) at the end of energy
4691 C term evaluation for this virtual-bond angle.
4692 if (term1.gt.term2) then
4694 term2=dexp(term2-termm)
4698 term1=dexp(term1-termm)
4701 C The ratio between the gamma-independent and gamma-dependent lobes of
4702 C the distribution is a Gaussian function of thet_pred_mean too.
4703 diffak=gthet(2,it)-thet_pred_mean
4704 ratak=diffak/gthet(3,it)**2
4705 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4706 C Let's differentiate it in thet_pred_mean NOW.
4708 C Now put together the distribution terms to make complete distribution.
4709 termexp=term1+ak*term2
4710 termpre=sigc+ak*sig0i
4711 C Contribution of the bending energy from this theta is just the -log of
4712 C the sum of the contributions from the two lobes and the pre-exponential
4713 C factor. Simple enough, isn't it?
4714 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4715 C NOW the derivatives!!!
4716 C 6/6/97 Take into account the deformation.
4717 E_theta=(delthec*sigcsq*term1
4718 & +ak*delthe0*sig0inv*term2)/termexp
4719 E_tc=((sigtc+aktc*sig0i)/termpre
4720 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4721 & aktc*term2)/termexp)
4724 c-----------------------------------------------------------------------------
4725 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4726 implicit real*8 (a-h,o-z)
4727 include 'DIMENSIONS'
4728 include 'COMMON.LOCAL'
4729 include 'COMMON.IOUNITS'
4730 common /calcthet/ term1,term2,termm,diffak,ratak,
4731 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4732 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4733 delthec=thetai-thet_pred_mean
4734 delthe0=thetai-theta0i
4735 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4736 t3 = thetai-thet_pred_mean
4740 t14 = t12+t6*sigsqtc
4742 t21 = thetai-theta0i
4748 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4749 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4750 & *(-t12*t9-ak*sig0inv*t27)
4754 C--------------------------------------------------------------------------
4755 subroutine ebend(etheta)
4757 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4758 C angles gamma and its derivatives in consecutive thetas and gammas.
4759 C ab initio-derived potentials from
4760 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4762 implicit real*8 (a-h,o-z)
4763 include 'DIMENSIONS'
4764 include 'COMMON.LOCAL'
4765 include 'COMMON.GEO'
4766 include 'COMMON.INTERACT'
4767 include 'COMMON.DERIV'
4768 include 'COMMON.VAR'
4769 include 'COMMON.CHAIN'
4770 include 'COMMON.IOUNITS'
4771 include 'COMMON.NAMES'
4772 include 'COMMON.FFIELD'
4773 include 'COMMON.CONTROL'
4774 include 'COMMON.TORCNSTR'
4775 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4776 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4777 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4778 & sinph1ph2(maxdouble,maxdouble)
4779 logical lprn /.false./, lprn1 /.false./
4781 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4782 do i=ithet_start,ithet_end
4784 C if (itype(i-1).eq.ntyp1) cycle
4786 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4787 & .or.itype(i).eq.ntyp1) cycle
4788 if (iabs(itype(i+1)).eq.20) iblock=2
4789 if (iabs(itype(i+1)).ne.20) iblock=1
4793 theti2=0.5d0*theta(i)
4794 ityp2=ithetyp((itype(i-1)))
4796 coskt(k)=dcos(k*theti2)
4797 sinkt(k)=dsin(k*theti2)
4807 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4810 if (phii.ne.phii) phii=150.0
4814 ityp1=ithetyp((itype(i-2)))
4816 cosph1(k)=dcos(k*phii)
4817 sinph1(k)=dsin(k*phii)
4823 ityp1=ithetyp((itype(i-2)))
4829 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4832 if (phii1.ne.phii1) phii1=150.0
4837 ityp3=ithetyp((itype(i)))
4839 cosph2(k)=dcos(k*phii1)
4840 sinph2(k)=dsin(k*phii1)
4845 ityp3=ithetyp((itype(i)))
4851 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4852 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4854 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4857 ccl=cosph1(l)*cosph2(k-l)
4858 ssl=sinph1(l)*sinph2(k-l)
4859 scl=sinph1(l)*cosph2(k-l)
4860 csl=cosph1(l)*sinph2(k-l)
4861 cosph1ph2(l,k)=ccl-ssl
4862 cosph1ph2(k,l)=ccl+ssl
4863 sinph1ph2(l,k)=scl+csl
4864 sinph1ph2(k,l)=scl-csl
4868 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4869 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4870 write (iout,*) "coskt and sinkt"
4872 write (iout,*) k,coskt(k),sinkt(k)
4876 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4877 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4880 & write (iout,*) "k",k,"
4881 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4882 & " ethetai",ethetai
4885 write (iout,*) "cosph and sinph"
4887 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4889 write (iout,*) "cosph1ph2 and sinph2ph2"
4892 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4893 & sinph1ph2(l,k),sinph1ph2(k,l)
4896 write(iout,*) "ethetai",ethetai
4900 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4901 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4902 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4903 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4904 ethetai=ethetai+sinkt(m)*aux
4905 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4906 dephii=dephii+k*sinkt(m)*(
4907 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4908 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4909 dephii1=dephii1+k*sinkt(m)*(
4910 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4911 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4913 & write (iout,*) "m",m," k",k," bbthet",
4914 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4915 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4916 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4917 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4921 & write(iout,*) "ethetai",ethetai
4925 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4926 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4927 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4928 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4929 ethetai=ethetai+sinkt(m)*aux
4930 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4931 dephii=dephii+l*sinkt(m)*(
4932 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4933 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4934 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4935 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4936 dephii1=dephii1+(k-l)*sinkt(m)*(
4937 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4938 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4939 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4940 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4942 write (iout,*) "m",m," k",k," l",l," ffthet",
4943 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4944 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4945 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4946 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4947 & " ethetai",ethetai
4948 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4949 & cosph1ph2(k,l)*sinkt(m),
4950 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4956 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4957 & i,theta(i)*rad2deg,phii*rad2deg,
4958 & phii1*rad2deg,ethetai
4959 etheta=etheta+ethetai
4960 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4961 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4962 c gloc(nphi+i-2,icg)=wang*dethetai
4963 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4969 c-----------------------------------------------------------------------------
4970 subroutine esc(escloc)
4971 C Calculate the local energy of a side chain and its derivatives in the
4972 C corresponding virtual-bond valence angles THETA and the spherical angles
4974 implicit real*8 (a-h,o-z)
4975 include 'DIMENSIONS'
4976 include 'COMMON.GEO'
4977 include 'COMMON.LOCAL'
4978 include 'COMMON.VAR'
4979 include 'COMMON.INTERACT'
4980 include 'COMMON.DERIV'
4981 include 'COMMON.CHAIN'
4982 include 'COMMON.IOUNITS'
4983 include 'COMMON.NAMES'
4984 include 'COMMON.FFIELD'
4985 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4986 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4987 common /sccalc/ time11,time12,time112,theti,it,nlobit
4990 C write (iout,*) 'ESC'
4991 do i=loc_start,loc_end
4993 if (it.eq.ntyp1) cycle
4994 if (it.eq.10) goto 1
4995 nlobit=nlob(iabs(it))
4996 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4997 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4998 theti=theta(i+1)-pipol
5002 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5004 if (x(2).gt.pi-delta) then
5008 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5010 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5011 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5013 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5014 & ddersc0(1),dersc(1))
5015 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5016 & ddersc0(3),dersc(3))
5018 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5020 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5021 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5022 & dersc0(2),esclocbi,dersc02)
5023 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5025 call splinthet(x(2),0.5d0*delta,ss,ssd)
5030 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5032 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5033 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5035 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5037 c write (iout,*) escloci
5038 else if (x(2).lt.delta) then
5042 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5044 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5045 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5047 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5048 & ddersc0(1),dersc(1))
5049 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5050 & ddersc0(3),dersc(3))
5052 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5054 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5055 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5056 & dersc0(2),esclocbi,dersc02)
5057 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5062 call splinthet(x(2),0.5d0*delta,ss,ssd)
5064 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5066 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5067 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5069 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5070 C write (iout,*) 'i=',i, escloci
5072 call enesc(x,escloci,dersc,ddummy,.false.)
5075 escloc=escloc+escloci
5076 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5077 write (iout,'(a6,i5,0pf7.3)')
5078 & 'escloc',i,escloci
5080 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5082 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5083 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5088 C---------------------------------------------------------------------------
5089 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5090 implicit real*8 (a-h,o-z)
5091 include 'DIMENSIONS'
5092 include 'COMMON.GEO'
5093 include 'COMMON.LOCAL'
5094 include 'COMMON.IOUNITS'
5095 common /sccalc/ time11,time12,time112,theti,it,nlobit
5096 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5097 double precision contr(maxlob,-1:1)
5099 c write (iout,*) 'it=',it,' nlobit=',nlobit
5103 if (mixed) ddersc(j)=0.0d0
5107 C Because of periodicity of the dependence of the SC energy in omega we have
5108 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5109 C To avoid underflows, first compute & store the exponents.
5117 z(k)=x(k)-censc(k,j,it)
5122 Axk=Axk+gaussc(l,k,j,it)*z(l)
5128 expfac=expfac+Ax(k,j,iii)*z(k)
5136 C As in the case of ebend, we want to avoid underflows in exponentiation and
5137 C subsequent NaNs and INFs in energy calculation.
5138 C Find the largest exponent
5142 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5146 cd print *,'it=',it,' emin=',emin
5148 C Compute the contribution to SC energy and derivatives
5152 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5153 cd print *,'j=',j,' expfac=',expfac
5154 escloc_i=escloc_i+expfac
5156 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5160 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5161 & +gaussc(k,2,j,it))*expfac
5168 dersc(1)=dersc(1)/cos(theti)**2
5169 ddersc(1)=ddersc(1)/cos(theti)**2
5172 escloci=-(dlog(escloc_i)-emin)
5174 dersc(j)=dersc(j)/escloc_i
5178 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5183 C------------------------------------------------------------------------------
5184 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5185 implicit real*8 (a-h,o-z)
5186 include 'DIMENSIONS'
5187 include 'COMMON.GEO'
5188 include 'COMMON.LOCAL'
5189 include 'COMMON.IOUNITS'
5190 common /sccalc/ time11,time12,time112,theti,it,nlobit
5191 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5192 double precision contr(maxlob)
5203 z(k)=x(k)-censc(k,j,it)
5209 Axk=Axk+gaussc(l,k,j,it)*z(l)
5215 expfac=expfac+Ax(k,j)*z(k)
5220 C As in the case of ebend, we want to avoid underflows in exponentiation and
5221 C subsequent NaNs and INFs in energy calculation.
5222 C Find the largest exponent
5225 if (emin.gt.contr(j)) emin=contr(j)
5229 C Compute the contribution to SC energy and derivatives
5233 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5234 escloc_i=escloc_i+expfac
5236 dersc(k)=dersc(k)+Ax(k,j)*expfac
5238 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5239 & +gaussc(1,2,j,it))*expfac
5243 dersc(1)=dersc(1)/cos(theti)**2
5244 dersc12=dersc12/cos(theti)**2
5245 escloci=-(dlog(escloc_i)-emin)
5247 dersc(j)=dersc(j)/escloc_i
5249 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5253 c----------------------------------------------------------------------------------
5254 subroutine esc(escloc)
5255 C Calculate the local energy of a side chain and its derivatives in the
5256 C corresponding virtual-bond valence angles THETA and the spherical angles
5257 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5258 C added by Urszula Kozlowska. 07/11/2007
5260 implicit real*8 (a-h,o-z)
5261 include 'DIMENSIONS'
5262 include 'COMMON.GEO'
5263 include 'COMMON.LOCAL'
5264 include 'COMMON.VAR'
5265 include 'COMMON.SCROT'
5266 include 'COMMON.INTERACT'
5267 include 'COMMON.DERIV'
5268 include 'COMMON.CHAIN'
5269 include 'COMMON.IOUNITS'
5270 include 'COMMON.NAMES'
5271 include 'COMMON.FFIELD'
5272 include 'COMMON.CONTROL'
5273 include 'COMMON.VECTORS'
5274 double precision x_prime(3),y_prime(3),z_prime(3)
5275 & , sumene,dsc_i,dp2_i,x(65),
5276 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5277 & de_dxx,de_dyy,de_dzz,de_dt
5278 double precision s1_t,s1_6_t,s2_t,s2_6_t
5280 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5281 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5282 & dt_dCi(3),dt_dCi1(3)
5283 common /sccalc/ time11,time12,time112,theti,it,nlobit
5286 do i=loc_start,loc_end
5287 if (itype(i).eq.ntyp1) cycle
5288 costtab(i+1) =dcos(theta(i+1))
5289 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5290 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5291 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5292 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5293 cosfac=dsqrt(cosfac2)
5294 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5295 sinfac=dsqrt(sinfac2)
5297 if (it.eq.10) goto 1
5299 C Compute the axes of tghe local cartesian coordinates system; store in
5300 c x_prime, y_prime and z_prime
5307 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5308 C & dc_norm(3,i+nres)
5310 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5311 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5314 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5317 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5318 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5319 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5320 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5321 c & " xy",scalar(x_prime(1),y_prime(1)),
5322 c & " xz",scalar(x_prime(1),z_prime(1)),
5323 c & " yy",scalar(y_prime(1),y_prime(1)),
5324 c & " yz",scalar(y_prime(1),z_prime(1)),
5325 c & " zz",scalar(z_prime(1),z_prime(1))
5327 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5328 C to local coordinate system. Store in xx, yy, zz.
5334 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5335 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5336 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5343 C Compute the energy of the ith side cbain
5345 c write (2,*) "xx",xx," yy",yy," zz",zz
5348 x(j) = sc_parmin(j,it)
5351 Cc diagnostics - remove later
5353 yy1 = dsin(alph(2))*dcos(omeg(2))
5354 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5355 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5356 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5358 C," --- ", xx_w,yy_w,zz_w
5361 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5362 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5364 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5365 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5367 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5368 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5369 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5370 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5371 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5373 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5374 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5375 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5376 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5377 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5379 dsc_i = 0.743d0+x(61)
5381 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5382 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5383 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5384 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5385 s1=(1+x(63))/(0.1d0 + dscp1)
5386 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5387 s2=(1+x(65))/(0.1d0 + dscp2)
5388 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5389 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5390 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5391 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5393 c & dscp1,dscp2,sumene
5394 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5395 escloc = escloc + sumene
5396 c write (2,*) "escloc",escloc
5397 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5399 if (.not. calc_grad) goto 1
5402 C This section to check the numerical derivatives of the energy of ith side
5403 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5404 C #define DEBUG in the code to turn it on.
5406 write (2,*) "sumene =",sumene
5410 write (2,*) xx,yy,zz
5411 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5412 de_dxx_num=(sumenep-sumene)/aincr
5414 write (2,*) "xx+ sumene from enesc=",sumenep
5417 write (2,*) xx,yy,zz
5418 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5419 de_dyy_num=(sumenep-sumene)/aincr
5421 write (2,*) "yy+ sumene from enesc=",sumenep
5424 write (2,*) xx,yy,zz
5425 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5426 de_dzz_num=(sumenep-sumene)/aincr
5428 write (2,*) "zz+ sumene from enesc=",sumenep
5429 costsave=cost2tab(i+1)
5430 sintsave=sint2tab(i+1)
5431 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5432 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5433 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5434 de_dt_num=(sumenep-sumene)/aincr
5435 write (2,*) " t+ sumene from enesc=",sumenep
5436 cost2tab(i+1)=costsave
5437 sint2tab(i+1)=sintsave
5438 C End of diagnostics section.
5441 C Compute the gradient of esc
5443 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5444 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5445 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5446 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5447 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5448 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5449 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5450 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5451 pom1=(sumene3*sint2tab(i+1)+sumene1)
5452 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5453 pom2=(sumene4*cost2tab(i+1)+sumene2)
5454 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5455 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5456 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5457 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5459 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5460 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5461 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5463 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5464 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5465 & +(pom1+pom2)*pom_dx
5467 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5470 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5471 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5472 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5474 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5475 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5476 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5477 & +x(59)*zz**2 +x(60)*xx*zz
5478 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5479 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5480 & +(pom1-pom2)*pom_dy
5482 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5485 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5486 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5487 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5488 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5489 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5490 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5491 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5492 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5494 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5497 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5498 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5499 & +pom1*pom_dt1+pom2*pom_dt2
5501 write(2,*), "de_dt = ", de_dt,de_dt_num
5505 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5506 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5507 cosfac2xx=cosfac2*xx
5508 sinfac2yy=sinfac2*yy
5510 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5512 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5514 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5515 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5516 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5517 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5518 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5519 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5520 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5521 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5522 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5523 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5527 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5528 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5529 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5530 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5533 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5534 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5535 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5537 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5538 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5542 dXX_Ctab(k,i)=dXX_Ci(k)
5543 dXX_C1tab(k,i)=dXX_Ci1(k)
5544 dYY_Ctab(k,i)=dYY_Ci(k)
5545 dYY_C1tab(k,i)=dYY_Ci1(k)
5546 dZZ_Ctab(k,i)=dZZ_Ci(k)
5547 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5548 dXX_XYZtab(k,i)=dXX_XYZ(k)
5549 dYY_XYZtab(k,i)=dYY_XYZ(k)
5550 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5554 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5555 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5556 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5557 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5558 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5560 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5561 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5562 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5563 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5564 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5565 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5566 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5567 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5569 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5570 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5572 C to check gradient call subroutine check_grad
5579 c------------------------------------------------------------------------------
5580 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5582 C This procedure calculates two-body contact function g(rij) and its derivative:
5585 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5588 C where x=(rij-r0ij)/delta
5590 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5593 double precision rij,r0ij,eps0ij,fcont,fprimcont
5594 double precision x,x2,x4,delta
5598 if (x.lt.-1.0D0) then
5601 else if (x.le.1.0D0) then
5604 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5605 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5612 c------------------------------------------------------------------------------
5613 subroutine splinthet(theti,delta,ss,ssder)
5614 implicit real*8 (a-h,o-z)
5615 include 'DIMENSIONS'
5616 include 'COMMON.VAR'
5617 include 'COMMON.GEO'
5620 if (theti.gt.pipol) then
5621 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5623 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5628 c------------------------------------------------------------------------------
5629 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5631 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5632 double precision ksi,ksi2,ksi3,a1,a2,a3
5633 a1=fprim0*delta/(f1-f0)
5639 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5640 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5643 c------------------------------------------------------------------------------
5644 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5646 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5647 double precision ksi,ksi2,ksi3,a1,a2,a3
5652 a2=3*(f1x-f0x)-2*fprim0x*delta
5653 a3=fprim0x*delta-2*(f1x-f0x)
5654 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5657 C-----------------------------------------------------------------------------
5659 C-----------------------------------------------------------------------------
5660 subroutine etor(etors,fact)
5661 implicit real*8 (a-h,o-z)
5662 include 'DIMENSIONS'
5663 include 'COMMON.VAR'
5664 include 'COMMON.GEO'
5665 include 'COMMON.LOCAL'
5666 include 'COMMON.TORSION'
5667 include 'COMMON.INTERACT'
5668 include 'COMMON.DERIV'
5669 include 'COMMON.CHAIN'
5670 include 'COMMON.NAMES'
5671 include 'COMMON.IOUNITS'
5672 include 'COMMON.FFIELD'
5673 include 'COMMON.TORCNSTR'
5675 C Set lprn=.true. for debugging
5679 do i=iphi_start,iphi_end
5680 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5681 & .or. itype(i).eq.ntyp1) cycle
5682 itori=itortyp(itype(i-2))
5683 itori1=itortyp(itype(i-1))
5686 C Proline-Proline pair is a special case...
5687 if (itori.eq.3 .and. itori1.eq.3) then
5688 if (phii.gt.-dwapi3) then
5690 fac=1.0D0/(1.0D0-cosphi)
5691 etorsi=v1(1,3,3)*fac
5692 etorsi=etorsi+etorsi
5693 etors=etors+etorsi-v1(1,3,3)
5694 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5697 v1ij=v1(j+1,itori,itori1)
5698 v2ij=v2(j+1,itori,itori1)
5701 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5702 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5706 v1ij=v1(j,itori,itori1)
5707 v2ij=v2(j,itori,itori1)
5710 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5711 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5715 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5716 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5717 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5718 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5719 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5723 c------------------------------------------------------------------------------
5725 subroutine etor(etors,fact)
5726 implicit real*8 (a-h,o-z)
5727 include 'DIMENSIONS'
5728 include 'COMMON.VAR'
5729 include 'COMMON.GEO'
5730 include 'COMMON.LOCAL'
5731 include 'COMMON.TORSION'
5732 include 'COMMON.INTERACT'
5733 include 'COMMON.DERIV'
5734 include 'COMMON.CHAIN'
5735 include 'COMMON.NAMES'
5736 include 'COMMON.IOUNITS'
5737 include 'COMMON.FFIELD'
5738 include 'COMMON.TORCNSTR'
5740 C Set lprn=.true. for debugging
5744 do i=iphi_start,iphi_end
5746 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5747 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5748 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5749 C & .or. itype(i).eq.ntyp1) cycle
5750 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5751 if (iabs(itype(i)).eq.20) then
5756 itori=itortyp(itype(i-2))
5757 itori1=itortyp(itype(i-1))
5760 C Regular cosine and sine terms
5761 do j=1,nterm(itori,itori1,iblock)
5762 v1ij=v1(j,itori,itori1,iblock)
5763 v2ij=v2(j,itori,itori1,iblock)
5766 etors=etors+v1ij*cosphi+v2ij*sinphi
5767 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5771 C E = SUM ----------------------------------- - v1
5772 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5774 cosphi=dcos(0.5d0*phii)
5775 sinphi=dsin(0.5d0*phii)
5776 do j=1,nlor(itori,itori1,iblock)
5777 vl1ij=vlor1(j,itori,itori1)
5778 vl2ij=vlor2(j,itori,itori1)
5779 vl3ij=vlor3(j,itori,itori1)
5780 pom=vl2ij*cosphi+vl3ij*sinphi
5781 pom1=1.0d0/(pom*pom+1.0d0)
5782 etors=etors+vl1ij*pom1
5783 c if (energy_dec) etors_ii=etors_ii+
5786 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5788 C Subtract the constant term
5789 etors=etors-v0(itori,itori1,iblock)
5791 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5792 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5793 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5794 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5795 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5800 c----------------------------------------------------------------------------
5801 subroutine etor_d(etors_d,fact2)
5802 C 6/23/01 Compute double torsional energy
5803 implicit real*8 (a-h,o-z)
5804 include 'DIMENSIONS'
5805 include 'COMMON.VAR'
5806 include 'COMMON.GEO'
5807 include 'COMMON.LOCAL'
5808 include 'COMMON.TORSION'
5809 include 'COMMON.INTERACT'
5810 include 'COMMON.DERIV'
5811 include 'COMMON.CHAIN'
5812 include 'COMMON.NAMES'
5813 include 'COMMON.IOUNITS'
5814 include 'COMMON.FFIELD'
5815 include 'COMMON.TORCNSTR'
5817 C Set lprn=.true. for debugging
5821 do i=iphi_start,iphi_end-1
5823 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5824 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5825 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5826 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5827 & (itype(i+1).eq.ntyp1)) cycle
5828 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5830 itori=itortyp(itype(i-2))
5831 itori1=itortyp(itype(i-1))
5832 itori2=itortyp(itype(i))
5838 if (iabs(itype(i+1)).eq.20) iblock=2
5839 C Regular cosine and sine terms
5840 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5841 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5842 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5843 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5844 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5845 cosphi1=dcos(j*phii)
5846 sinphi1=dsin(j*phii)
5847 cosphi2=dcos(j*phii1)
5848 sinphi2=dsin(j*phii1)
5849 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5850 & v2cij*cosphi2+v2sij*sinphi2
5851 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5852 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5854 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5856 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5857 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5858 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5859 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5860 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5861 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5862 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5863 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5864 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5865 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5866 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5867 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5868 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5869 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5872 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5873 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5879 c---------------------------------------------------------------------------
5880 C The rigorous attempt to derive energy function
5881 subroutine etor_kcc(etors,fact)
5882 implicit real*8 (a-h,o-z)
5883 include 'DIMENSIONS'
5884 include 'COMMON.VAR'
5885 include 'COMMON.GEO'
5886 include 'COMMON.LOCAL'
5887 include 'COMMON.TORSION'
5888 include 'COMMON.INTERACT'
5889 include 'COMMON.DERIV'
5890 include 'COMMON.CHAIN'
5891 include 'COMMON.NAMES'
5892 include 'COMMON.IOUNITS'
5893 include 'COMMON.FFIELD'
5894 include 'COMMON.TORCNSTR'
5895 include 'COMMON.CONTROL'
5896 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
5898 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
5899 C Set lprn=.true. for debugging
5902 C print *,"wchodze kcc"
5903 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
5905 do i=iphi_start,iphi_end
5906 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5907 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5908 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5909 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5910 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5911 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5912 itori=itortyp(itype(i-2))
5913 itori1=itortyp(itype(i-1))
5918 C to avoid multiple devision by 2
5919 c theti22=0.5d0*theta(i)
5920 C theta 12 is the theta_1 /2
5921 C theta 22 is theta_2 /2
5922 c theti12=0.5d0*theta(i-1)
5923 C and appropriate sinus function
5924 sinthet1=dsin(theta(i-1))
5925 sinthet2=dsin(theta(i))
5926 costhet1=dcos(theta(i-1))
5927 costhet2=dcos(theta(i))
5928 C to speed up lets store its mutliplication
5929 sint1t2=sinthet2*sinthet1
5931 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
5932 C +d_n*sin(n*gamma)) *
5933 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
5934 C we have two sum 1) Non-Chebyshev which is with n and gamma
5935 nval=nterm_kcc_Tb(itori,itori1)
5941 c1(j)=c1(j-1)*costhet1
5942 c2(j)=c2(j-1)*costhet2
5945 do j=1,nterm_kcc(itori,itori1)
5949 sint1t2n=sint1t2n*sint1t2
5955 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5956 gradvalct1=gradvalct1+
5957 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5958 gradvalct2=gradvalct2+
5959 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5962 gradvalct1=-gradvalct1*sinthet1
5963 gradvalct2=-gradvalct2*sinthet2
5969 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5970 gradvalst1=gradvalst1+
5971 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5972 gradvalst2=gradvalst2+
5973 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5976 gradvalst1=-gradvalst1*sinthet1
5977 gradvalst2=-gradvalst2*sinthet2
5978 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
5979 C glocig is the gradient local i site in gamma
5980 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
5981 C now gradient over theta_1
5982 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
5983 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
5984 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
5985 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
5988 C derivative over gamma
5989 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
5990 C derivative over theta1
5991 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
5992 C now derivative over theta2
5993 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
5995 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
5996 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6000 c---------------------------------------------------------------------------------------------
6001 subroutine etor_constr(edihcnstr)
6002 implicit real*8 (a-h,o-z)
6003 include 'DIMENSIONS'
6004 include 'COMMON.VAR'
6005 include 'COMMON.GEO'
6006 include 'COMMON.LOCAL'
6007 include 'COMMON.TORSION'
6008 include 'COMMON.INTERACT'
6009 include 'COMMON.DERIV'
6010 include 'COMMON.CHAIN'
6011 include 'COMMON.NAMES'
6012 include 'COMMON.IOUNITS'
6013 include 'COMMON.FFIELD'
6014 include 'COMMON.TORCNSTR'
6015 include 'COMMON.CONTROL'
6016 ! 6/20/98 - dihedral angle constraints
6018 c do i=1,ndih_constr
6019 c write (iout,*) "idihconstr_start",idihconstr_start,
6020 c & " idihconstr_end",idihconstr_end
6021 if (raw_psipred) then
6022 do i=idihconstr_start,idihconstr_end
6023 itori=idih_constr(i)
6025 gaudih_i=vpsipred(1,i)
6029 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6030 dexpcos_i=dexp(-cos_i*cos_i)
6031 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6032 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6033 & *cos_i*dexpcos_i/s**2
6035 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6036 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6038 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6039 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6040 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6041 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6042 & -wdihc*dlog(gaudih_i)
6045 do i=idihconstr_start,idihconstr_end
6046 itori=idih_constr(i)
6048 difi=pinorm(phii-phi0(i))
6049 if (difi.gt.drange(i)) then
6051 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6052 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6053 else if (difi.lt.-drange(i)) then
6055 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6056 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6064 c----------------------------------------------------------------------------
6065 C The rigorous attempt to derive energy function
6066 subroutine ebend_kcc(etheta)
6068 implicit real*8 (a-h,o-z)
6069 include 'DIMENSIONS'
6070 include 'COMMON.VAR'
6071 include 'COMMON.GEO'
6072 include 'COMMON.LOCAL'
6073 include 'COMMON.TORSION'
6074 include 'COMMON.INTERACT'
6075 include 'COMMON.DERIV'
6076 include 'COMMON.CHAIN'
6077 include 'COMMON.NAMES'
6078 include 'COMMON.IOUNITS'
6079 include 'COMMON.FFIELD'
6080 include 'COMMON.TORCNSTR'
6081 include 'COMMON.CONTROL'
6083 double precision thybt1(maxang_kcc)
6084 C Set lprn=.true. for debugging
6087 C print *,"wchodze kcc"
6088 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6090 do i=ithet_start,ithet_end
6091 c print *,i,itype(i-1),itype(i),itype(i-2)
6092 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6093 & .or.itype(i).eq.ntyp1) cycle
6094 iti=iabs(itortyp(itype(i-1)))
6095 sinthet=dsin(theta(i))
6096 costhet=dcos(theta(i))
6097 do j=1,nbend_kcc_Tb(iti)
6098 thybt1(j)=v1bend_chyb(j,iti)
6100 sumth1thyb=v1bend_chyb(0,iti)+
6101 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6102 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6104 ihelp=nbend_kcc_Tb(iti)-1
6105 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6106 etheta=etheta+sumth1thyb
6107 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6108 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6112 c-------------------------------------------------------------------------------------
6113 subroutine etheta_constr(ethetacnstr)
6115 implicit real*8 (a-h,o-z)
6116 include 'DIMENSIONS'
6117 include 'COMMON.VAR'
6118 include 'COMMON.GEO'
6119 include 'COMMON.LOCAL'
6120 include 'COMMON.TORSION'
6121 include 'COMMON.INTERACT'
6122 include 'COMMON.DERIV'
6123 include 'COMMON.CHAIN'
6124 include 'COMMON.NAMES'
6125 include 'COMMON.IOUNITS'
6126 include 'COMMON.FFIELD'
6127 include 'COMMON.TORCNSTR'
6128 include 'COMMON.CONTROL'
6130 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6131 do i=ithetaconstr_start,ithetaconstr_end
6132 itheta=itheta_constr(i)
6133 thetiii=theta(itheta)
6134 difi=pinorm(thetiii-theta_constr0(i))
6135 if (difi.gt.theta_drange(i)) then
6136 difi=difi-theta_drange(i)
6137 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6138 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6139 & +for_thet_constr(i)*difi**3
6140 else if (difi.lt.-drange(i)) then
6142 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6143 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6144 & +for_thet_constr(i)*difi**3
6148 if (energy_dec) then
6149 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6150 & i,itheta,rad2deg*thetiii,
6151 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6152 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6153 & gloc(itheta+nphi-2,icg)
6158 c------------------------------------------------------------------------------
6159 c------------------------------------------------------------------------------
6160 subroutine eback_sc_corr(esccor)
6161 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6162 c conformational states; temporarily implemented as differences
6163 c between UNRES torsional potentials (dependent on three types of
6164 c residues) and the torsional potentials dependent on all 20 types
6165 c of residues computed from AM1 energy surfaces of terminally-blocked
6166 c amino-acid residues.
6167 implicit real*8 (a-h,o-z)
6168 include 'DIMENSIONS'
6169 include 'COMMON.VAR'
6170 include 'COMMON.GEO'
6171 include 'COMMON.LOCAL'
6172 include 'COMMON.TORSION'
6173 include 'COMMON.SCCOR'
6174 include 'COMMON.INTERACT'
6175 include 'COMMON.DERIV'
6176 include 'COMMON.CHAIN'
6177 include 'COMMON.NAMES'
6178 include 'COMMON.IOUNITS'
6179 include 'COMMON.FFIELD'
6180 include 'COMMON.CONTROL'
6182 C Set lprn=.true. for debugging
6185 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6187 do i=itau_start,itau_end
6188 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6190 isccori=isccortyp(itype(i-2))
6191 isccori1=isccortyp(itype(i-1))
6193 do intertyp=1,3 !intertyp
6194 cc Added 09 May 2012 (Adasko)
6195 cc Intertyp means interaction type of backbone mainchain correlation:
6196 c 1 = SC...Ca...Ca...Ca
6197 c 2 = Ca...Ca...Ca...SC
6198 c 3 = SC...Ca...Ca...SCi
6200 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6201 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6202 & (itype(i-1).eq.ntyp1)))
6203 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6204 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6205 & .or.(itype(i).eq.ntyp1)))
6206 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6207 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6208 & (itype(i-3).eq.ntyp1)))) cycle
6209 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6210 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6212 do j=1,nterm_sccor(isccori,isccori1)
6213 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6214 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6215 cosphi=dcos(j*tauangle(intertyp,i))
6216 sinphi=dsin(j*tauangle(intertyp,i))
6217 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6218 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6220 C write (iout,*)"EBACK_SC_COR",esccor,i
6221 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6222 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6223 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6225 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6226 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6227 & (v1sccor(j,1,itori,itori1),j=1,6)
6228 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6229 c gsccor_loc(i-3)=gloci
6234 c------------------------------------------------------------------------------
6235 subroutine multibody(ecorr)
6236 C This subroutine calculates multi-body contributions to energy following
6237 C the idea of Skolnick et al. If side chains I and J make a contact and
6238 C at the same time side chains I+1 and J+1 make a contact, an extra
6239 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6240 implicit real*8 (a-h,o-z)
6241 include 'DIMENSIONS'
6242 include 'COMMON.IOUNITS'
6243 include 'COMMON.DERIV'
6244 include 'COMMON.INTERACT'
6245 include 'COMMON.CONTACTS'
6246 double precision gx(3),gx1(3)
6249 C Set lprn=.true. for debugging
6253 write (iout,'(a)') 'Contact function values:'
6255 write (iout,'(i2,20(1x,i2,f10.5))')
6256 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6271 num_conti=num_cont(i)
6272 num_conti1=num_cont(i1)
6277 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6278 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6279 cd & ' ishift=',ishift
6280 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6281 C The system gains extra energy.
6282 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6283 endif ! j1==j+-ishift
6292 c------------------------------------------------------------------------------
6293 double precision function esccorr(i,j,k,l,jj,kk)
6294 implicit real*8 (a-h,o-z)
6295 include 'DIMENSIONS'
6296 include 'COMMON.IOUNITS'
6297 include 'COMMON.DERIV'
6298 include 'COMMON.INTERACT'
6299 include 'COMMON.CONTACTS'
6300 double precision gx(3),gx1(3)
6305 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6306 C Calculate the multi-body contribution to energy.
6307 C Calculate multi-body contributions to the gradient.
6308 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6309 cd & k,l,(gacont(m,kk,k),m=1,3)
6311 gx(m) =ekl*gacont(m,jj,i)
6312 gx1(m)=eij*gacont(m,kk,k)
6313 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6314 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6315 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6316 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6320 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6325 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6331 c------------------------------------------------------------------------------
6332 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6333 C This subroutine calculates multi-body contributions to hydrogen-bonding
6334 implicit real*8 (a-h,o-z)
6335 include 'DIMENSIONS'
6336 include 'COMMON.IOUNITS'
6337 include 'COMMON.FFIELD'
6338 include 'COMMON.DERIV'
6339 include 'COMMON.INTERACT'
6340 include 'COMMON.CONTACTS'
6341 double precision gx(3),gx1(3)
6344 C Set lprn=.true. for debugging
6347 write (iout,'(a)') 'Contact function values:'
6349 write (iout,'(2i3,50(1x,i2,f5.2))')
6350 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6351 & j=1,num_cont_hb(i))
6355 C Remove the loop below after debugging !!!
6362 C Calculate the local-electrostatic correlation terms
6363 do i=iatel_s,iatel_e+1
6365 num_conti=num_cont_hb(i)
6366 num_conti1=num_cont_hb(i+1)
6371 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6372 c & ' jj=',jj,' kk=',kk
6373 if (j1.eq.j+1 .or. j1.eq.j-1) then
6374 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6375 C The system gains extra energy.
6376 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6378 else if (j1.eq.j) then
6379 C Contacts I-J and I-(J+1) occur simultaneously.
6380 C The system loses extra energy.
6381 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6386 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6387 c & ' jj=',jj,' kk=',kk
6389 C Contacts I-J and (I+1)-J occur simultaneously.
6390 C The system loses extra energy.
6391 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6398 c------------------------------------------------------------------------------
6399 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6401 C This subroutine calculates multi-body contributions to hydrogen-bonding
6402 implicit real*8 (a-h,o-z)
6403 include 'DIMENSIONS'
6404 include 'COMMON.IOUNITS'
6408 include 'COMMON.FFIELD'
6409 include 'COMMON.DERIV'
6410 include 'COMMON.LOCAL'
6411 include 'COMMON.INTERACT'
6412 include 'COMMON.CONTACTS'
6413 include 'COMMON.CHAIN'
6414 include 'COMMON.CONTROL'
6415 include 'COMMON.SHIELD'
6416 double precision gx(3),gx1(3)
6417 integer num_cont_hb_old(maxres)
6419 double precision eello4,eello5,eelo6,eello_turn6
6420 external eello4,eello5,eello6,eello_turn6
6421 C Set lprn=.true. for debugging
6425 write (iout,'(a)') 'Contact function values:'
6427 write (iout,'(2i3,50(1x,i2,5f6.3))')
6428 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6429 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6435 C Remove the loop below after debugging !!!
6442 C Calculate the dipole-dipole interaction energies
6443 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6444 do i=iatel_s,iatel_e+1
6445 num_conti=num_cont_hb(i)
6454 C Calculate the local-electrostatic correlation terms
6455 c write (iout,*) "gradcorr5 in eello5 before loop"
6457 c write (iout,'(i5,3f10.5)')
6458 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6460 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6461 c write (iout,*) "corr loop i",i
6463 num_conti=num_cont_hb(i)
6464 num_conti1=num_cont_hb(i+1)
6471 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6472 c & ' jj=',jj,' kk=',kk
6473 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6474 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6475 & .or. j.lt.0 .and. j1.gt.0) .and.
6476 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6477 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6478 C The system gains extra energy.
6480 sqd1=dsqrt(d_cont(jj,i))
6481 sqd2=dsqrt(d_cont(kk,i1))
6482 sred_geom = sqd1*sqd2
6483 IF (sred_geom.lt.cutoff_corr) THEN
6484 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6486 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6487 cd & ' jj=',jj,' kk=',kk
6488 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6489 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6491 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6492 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6495 cd write (iout,*) 'sred_geom=',sred_geom,
6496 cd & ' ekont=',ekont,' fprim=',fprimcont,
6497 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6498 cd write (iout,*) "g_contij",g_contij
6499 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6500 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6501 call calc_eello(i,jp,i+1,jp1,jj,kk)
6502 if (wcorr4.gt.0.0d0)
6503 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6504 CC & *fac_shield(i)**2*fac_shield(j)**2
6505 if (energy_dec.and.wcorr4.gt.0.0d0)
6506 1 write (iout,'(a6,4i5,0pf7.3)')
6507 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6508 c write (iout,*) "gradcorr5 before eello5"
6510 c write (iout,'(i5,3f10.5)')
6511 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6513 if (wcorr5.gt.0.0d0)
6514 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6515 c write (iout,*) "gradcorr5 after eello5"
6517 c write (iout,'(i5,3f10.5)')
6518 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6520 if (energy_dec.and.wcorr5.gt.0.0d0)
6521 1 write (iout,'(a6,4i5,0pf7.3)')
6522 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6523 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6524 cd write(2,*)'ijkl',i,jp,i+1,jp1
6525 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6526 & .or. wturn6.eq.0.0d0))then
6527 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6528 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6529 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6530 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6531 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6532 cd & 'ecorr6=',ecorr6
6533 cd write (iout,'(4e15.5)') sred_geom,
6534 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6535 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6536 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6537 else if (wturn6.gt.0.0d0
6538 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6539 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6540 eturn6=eturn6+eello_turn6(i,jj,kk)
6541 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6542 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6543 cd write (2,*) 'multibody_eello:eturn6',eturn6
6552 num_cont_hb(i)=num_cont_hb_old(i)
6554 c write (iout,*) "gradcorr5 in eello5"
6556 c write (iout,'(i5,3f10.5)')
6557 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6561 c------------------------------------------------------------------------------
6562 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6563 implicit real*8 (a-h,o-z)
6564 include 'DIMENSIONS'
6565 include 'COMMON.IOUNITS'
6566 include 'COMMON.DERIV'
6567 include 'COMMON.INTERACT'
6568 include 'COMMON.CONTACTS'
6569 include 'COMMON.SHIELD'
6570 include 'COMMON.CONTROL'
6571 double precision gx(3),gx1(3)
6574 C print *,"wchodze",fac_shield(i),shield_mode
6582 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6584 C & fac_shield(i)**2*fac_shield(j)**2
6585 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6586 C Following 4 lines for diagnostics.
6591 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6592 c & 'Contacts ',i,j,
6593 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6594 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6596 C Calculate the multi-body contribution to energy.
6597 C ecorr=ecorr+ekont*ees
6598 C Calculate multi-body contributions to the gradient.
6599 coeffpees0pij=coeffp*ees0pij
6600 coeffmees0mij=coeffm*ees0mij
6601 coeffpees0pkl=coeffp*ees0pkl
6602 coeffmees0mkl=coeffm*ees0mkl
6604 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6605 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6606 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6607 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6608 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6609 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6610 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6611 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6612 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6613 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6614 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6615 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6616 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6617 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6618 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6619 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6620 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6621 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6622 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6623 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6624 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6625 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6626 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6627 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6628 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6633 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6634 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6635 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6636 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6641 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6642 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6643 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6644 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6647 c write (iout,*) "ehbcorr",ekont*ees
6648 C print *,ekont,ees,i,k
6650 C now gradient over shielding
6652 if (shield_mode.gt.0) then
6655 C print *,i,j,fac_shield(i),fac_shield(j),
6656 C &fac_shield(k),fac_shield(l)
6657 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6658 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6659 do ilist=1,ishield_list(i)
6660 iresshield=shield_list(ilist,i)
6662 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6664 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6666 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6667 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6671 do ilist=1,ishield_list(j)
6672 iresshield=shield_list(ilist,j)
6674 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6676 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6678 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6679 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6684 do ilist=1,ishield_list(k)
6685 iresshield=shield_list(ilist,k)
6687 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6689 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6691 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6692 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6696 do ilist=1,ishield_list(l)
6697 iresshield=shield_list(ilist,l)
6699 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6701 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6703 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6704 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6708 C print *,gshieldx(m,iresshield)
6710 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6711 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6712 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6713 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6714 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6715 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6716 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6717 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6719 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6720 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6721 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6722 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6723 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6724 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6725 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6726 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6734 C---------------------------------------------------------------------------
6735 subroutine dipole(i,j,jj)
6736 implicit real*8 (a-h,o-z)
6737 include 'DIMENSIONS'
6738 include 'COMMON.IOUNITS'
6739 include 'COMMON.CHAIN'
6740 include 'COMMON.FFIELD'
6741 include 'COMMON.DERIV'
6742 include 'COMMON.INTERACT'
6743 include 'COMMON.CONTACTS'
6744 include 'COMMON.TORSION'
6745 include 'COMMON.VAR'
6746 include 'COMMON.GEO'
6747 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6749 iti1 = itortyp(itype(i+1))
6750 if (j.lt.nres-1) then
6751 itj1 = itype2loc(itype(j+1))
6756 dipi(iii,1)=Ub2(iii,i)
6757 dipderi(iii)=Ub2der(iii,i)
6758 dipi(iii,2)=b1(iii,i+1)
6759 dipj(iii,1)=Ub2(iii,j)
6760 dipderj(iii)=Ub2der(iii,j)
6761 dipj(iii,2)=b1(iii,j+1)
6765 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6768 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6775 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6779 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6784 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6785 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6787 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6789 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6791 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6796 C---------------------------------------------------------------------------
6797 subroutine calc_eello(i,j,k,l,jj,kk)
6799 C This subroutine computes matrices and vectors needed to calculate
6800 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6802 implicit real*8 (a-h,o-z)
6803 include 'DIMENSIONS'
6804 include 'COMMON.IOUNITS'
6805 include 'COMMON.CHAIN'
6806 include 'COMMON.DERIV'
6807 include 'COMMON.INTERACT'
6808 include 'COMMON.CONTACTS'
6809 include 'COMMON.TORSION'
6810 include 'COMMON.VAR'
6811 include 'COMMON.GEO'
6812 include 'COMMON.FFIELD'
6813 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6814 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6817 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6818 cd & ' jj=',jj,' kk=',kk
6819 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6820 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6821 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6824 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6825 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6828 call transpose2(aa1(1,1),aa1t(1,1))
6829 call transpose2(aa2(1,1),aa2t(1,1))
6832 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6833 & aa1tder(1,1,lll,kkk))
6834 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6835 & aa2tder(1,1,lll,kkk))
6839 C parallel orientation of the two CA-CA-CA frames.
6841 iti=itype2loc(itype(i))
6845 itk1=itype2loc(itype(k+1))
6846 itj=itype2loc(itype(j))
6847 if (l.lt.nres-1) then
6848 itl1=itype2loc(itype(l+1))
6852 C A1 kernel(j+1) A2T
6854 cd write (iout,'(3f10.5,5x,3f10.5)')
6855 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6857 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6858 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6859 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6860 C Following matrices are needed only for 6-th order cumulants
6861 IF (wcorr6.gt.0.0d0) THEN
6862 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6863 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6864 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6865 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6866 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6867 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6868 & ADtEAderx(1,1,1,1,1,1))
6870 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6871 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6872 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6873 & ADtEA1derx(1,1,1,1,1,1))
6875 C End 6-th order cumulants
6878 cd write (2,*) 'In calc_eello6'
6880 cd write (2,*) 'iii=',iii
6882 cd write (2,*) 'kkk=',kkk
6884 cd write (2,'(3(2f10.5),5x)')
6885 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6890 call transpose2(EUgder(1,1,k),auxmat(1,1))
6891 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6892 call transpose2(EUg(1,1,k),auxmat(1,1))
6893 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6894 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6898 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6899 & EAEAderx(1,1,lll,kkk,iii,1))
6903 C A1T kernel(i+1) A2
6904 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6905 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6906 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6907 C Following matrices are needed only for 6-th order cumulants
6908 IF (wcorr6.gt.0.0d0) THEN
6909 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6910 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6911 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6912 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6913 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6914 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6915 & ADtEAderx(1,1,1,1,1,2))
6916 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6917 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6918 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6919 & ADtEA1derx(1,1,1,1,1,2))
6921 C End 6-th order cumulants
6922 call transpose2(EUgder(1,1,l),auxmat(1,1))
6923 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6924 call transpose2(EUg(1,1,l),auxmat(1,1))
6925 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6926 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6930 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6931 & EAEAderx(1,1,lll,kkk,iii,2))
6936 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6937 C They are needed only when the fifth- or the sixth-order cumulants are
6939 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6940 call transpose2(AEA(1,1,1),auxmat(1,1))
6941 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
6942 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6943 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6944 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6945 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
6946 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6947 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
6948 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
6949 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6950 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6951 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6952 call transpose2(AEA(1,1,2),auxmat(1,1))
6953 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
6954 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6955 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6956 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6957 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
6958 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6959 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
6960 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
6961 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6962 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6963 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6964 C Calculate the Cartesian derivatives of the vectors.
6968 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6969 call matvec2(auxmat(1,1),b1(1,i),
6970 & AEAb1derx(1,lll,kkk,iii,1,1))
6971 call matvec2(auxmat(1,1),Ub2(1,i),
6972 & AEAb2derx(1,lll,kkk,iii,1,1))
6973 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
6974 & AEAb1derx(1,lll,kkk,iii,2,1))
6975 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6976 & AEAb2derx(1,lll,kkk,iii,2,1))
6977 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6978 call matvec2(auxmat(1,1),b1(1,j),
6979 & AEAb1derx(1,lll,kkk,iii,1,2))
6980 call matvec2(auxmat(1,1),Ub2(1,j),
6981 & AEAb2derx(1,lll,kkk,iii,1,2))
6982 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
6983 & AEAb1derx(1,lll,kkk,iii,2,2))
6984 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6985 & AEAb2derx(1,lll,kkk,iii,2,2))
6992 C Antiparallel orientation of the two CA-CA-CA frames.
6994 iti=itype2loc(itype(i))
6998 itk1=itype2loc(itype(k+1))
6999 itl=itype2loc(itype(l))
7000 itj=itype2loc(itype(j))
7001 if (j.lt.nres-1) then
7002 itj1=itype2loc(itype(j+1))
7006 C A2 kernel(j-1)T A1T
7007 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7008 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7009 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7010 C Following matrices are needed only for 6-th order cumulants
7011 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7012 & j.eq.i+4 .and. l.eq.i+3)) THEN
7013 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7014 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7015 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7016 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7017 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7018 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7019 & ADtEAderx(1,1,1,1,1,1))
7020 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7021 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7022 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7023 & ADtEA1derx(1,1,1,1,1,1))
7025 C End 6-th order cumulants
7026 call transpose2(EUgder(1,1,k),auxmat(1,1))
7027 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7028 call transpose2(EUg(1,1,k),auxmat(1,1))
7029 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7030 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7034 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7035 & EAEAderx(1,1,lll,kkk,iii,1))
7039 C A2T kernel(i+1)T A1
7040 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7041 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7042 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7043 C Following matrices are needed only for 6-th order cumulants
7044 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7045 & j.eq.i+4 .and. l.eq.i+3)) THEN
7046 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7047 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7048 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7049 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7050 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7051 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7052 & ADtEAderx(1,1,1,1,1,2))
7053 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7054 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7055 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7056 & ADtEA1derx(1,1,1,1,1,2))
7058 C End 6-th order cumulants
7059 call transpose2(EUgder(1,1,j),auxmat(1,1))
7060 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7061 call transpose2(EUg(1,1,j),auxmat(1,1))
7062 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7063 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7067 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7068 & EAEAderx(1,1,lll,kkk,iii,2))
7073 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7074 C They are needed only when the fifth- or the sixth-order cumulants are
7076 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7077 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7078 call transpose2(AEA(1,1,1),auxmat(1,1))
7079 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7080 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7081 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7082 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7083 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7084 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7085 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7086 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7087 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7088 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7089 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7090 call transpose2(AEA(1,1,2),auxmat(1,1))
7091 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7092 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7093 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7094 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7095 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7096 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7097 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7098 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7099 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7100 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7101 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7102 C Calculate the Cartesian derivatives of the vectors.
7106 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7107 call matvec2(auxmat(1,1),b1(1,i),
7108 & AEAb1derx(1,lll,kkk,iii,1,1))
7109 call matvec2(auxmat(1,1),Ub2(1,i),
7110 & AEAb2derx(1,lll,kkk,iii,1,1))
7111 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7112 & AEAb1derx(1,lll,kkk,iii,2,1))
7113 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7114 & AEAb2derx(1,lll,kkk,iii,2,1))
7115 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7116 call matvec2(auxmat(1,1),b1(1,l),
7117 & AEAb1derx(1,lll,kkk,iii,1,2))
7118 call matvec2(auxmat(1,1),Ub2(1,l),
7119 & AEAb2derx(1,lll,kkk,iii,1,2))
7120 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7121 & AEAb1derx(1,lll,kkk,iii,2,2))
7122 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7123 & AEAb2derx(1,lll,kkk,iii,2,2))
7132 C---------------------------------------------------------------------------
7133 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7134 & KK,KKderg,AKA,AKAderg,AKAderx)
7138 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7139 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7140 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7145 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7147 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7150 cd if (lprn) write (2,*) 'In kernel'
7152 cd if (lprn) write (2,*) 'kkk=',kkk
7154 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7155 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7157 cd write (2,*) 'lll=',lll
7158 cd write (2,*) 'iii=1'
7160 cd write (2,'(3(2f10.5),5x)')
7161 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7164 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7165 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7167 cd write (2,*) 'lll=',lll
7168 cd write (2,*) 'iii=2'
7170 cd write (2,'(3(2f10.5),5x)')
7171 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7178 C---------------------------------------------------------------------------
7179 double precision function eello4(i,j,k,l,jj,kk)
7180 implicit real*8 (a-h,o-z)
7181 include 'DIMENSIONS'
7182 include 'COMMON.IOUNITS'
7183 include 'COMMON.CHAIN'
7184 include 'COMMON.DERIV'
7185 include 'COMMON.INTERACT'
7186 include 'COMMON.CONTACTS'
7187 include 'COMMON.TORSION'
7188 include 'COMMON.VAR'
7189 include 'COMMON.GEO'
7190 double precision pizda(2,2),ggg1(3),ggg2(3)
7191 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7195 cd print *,'eello4:',i,j,k,l,jj,kk
7196 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7197 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7198 cold eij=facont_hb(jj,i)
7199 cold ekl=facont_hb(kk,k)
7201 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7203 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7204 gcorr_loc(k-1)=gcorr_loc(k-1)
7205 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7207 gcorr_loc(l-1)=gcorr_loc(l-1)
7208 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7210 gcorr_loc(j-1)=gcorr_loc(j-1)
7211 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7216 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7217 & -EAEAderx(2,2,lll,kkk,iii,1)
7218 cd derx(lll,kkk,iii)=0.0d0
7222 cd gcorr_loc(l-1)=0.0d0
7223 cd gcorr_loc(j-1)=0.0d0
7224 cd gcorr_loc(k-1)=0.0d0
7226 cd write (iout,*)'Contacts have occurred for peptide groups',
7227 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7228 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7229 if (j.lt.nres-1) then
7236 if (l.lt.nres-1) then
7244 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7245 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7246 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7247 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7248 cgrad ghalf=0.5d0*ggg1(ll)
7249 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7250 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7251 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7252 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7253 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7254 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7255 cgrad ghalf=0.5d0*ggg2(ll)
7256 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7257 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7258 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7259 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7260 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7261 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7265 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7270 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7275 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7280 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7284 cd write (2,*) iii,gcorr_loc(iii)
7288 cd write (2,*) 'ekont',ekont
7289 cd write (iout,*) 'eello4',ekont*eel4
7292 C---------------------------------------------------------------------------
7293 double precision function eello5(i,j,k,l,jj,kk)
7294 implicit real*8 (a-h,o-z)
7295 include 'DIMENSIONS'
7296 include 'COMMON.IOUNITS'
7297 include 'COMMON.CHAIN'
7298 include 'COMMON.DERIV'
7299 include 'COMMON.INTERACT'
7300 include 'COMMON.CONTACTS'
7301 include 'COMMON.TORSION'
7302 include 'COMMON.VAR'
7303 include 'COMMON.GEO'
7304 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7305 double precision ggg1(3),ggg2(3)
7306 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7311 C /l\ / \ \ / \ / \ / C
7312 C / \ / \ \ / \ / \ / C
7313 C j| o |l1 | o | o| o | | o |o C
7314 C \ |/k\| |/ \| / |/ \| |/ \| C
7315 C \i/ \ / \ / / \ / \ C
7317 C (I) (II) (III) (IV) C
7319 C eello5_1 eello5_2 eello5_3 eello5_4 C
7321 C Antiparallel chains C
7324 C /j\ / \ \ / \ / \ / C
7325 C / \ / \ \ / \ / \ / C
7326 C j1| o |l | o | o| o | | o |o C
7327 C \ |/k\| |/ \| / |/ \| |/ \| C
7328 C \i/ \ / \ / / \ / \ C
7330 C (I) (II) (III) (IV) C
7332 C eello5_1 eello5_2 eello5_3 eello5_4 C
7334 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7336 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7337 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7342 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7344 itk=itype2loc(itype(k))
7345 itl=itype2loc(itype(l))
7346 itj=itype2loc(itype(j))
7351 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7352 cd & eel5_3_num,eel5_4_num)
7356 derx(lll,kkk,iii)=0.0d0
7360 cd eij=facont_hb(jj,i)
7361 cd ekl=facont_hb(kk,k)
7363 cd write (iout,*)'Contacts have occurred for peptide groups',
7364 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7366 C Contribution from the graph I.
7367 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7368 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7369 call transpose2(EUg(1,1,k),auxmat(1,1))
7370 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7371 vv(1)=pizda(1,1)-pizda(2,2)
7372 vv(2)=pizda(1,2)+pizda(2,1)
7373 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7374 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7376 C Explicit gradient in virtual-dihedral angles.
7377 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7378 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7379 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7380 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7381 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7382 vv(1)=pizda(1,1)-pizda(2,2)
7383 vv(2)=pizda(1,2)+pizda(2,1)
7384 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7385 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7386 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7387 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7388 vv(1)=pizda(1,1)-pizda(2,2)
7389 vv(2)=pizda(1,2)+pizda(2,1)
7391 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7392 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7393 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7395 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7396 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7397 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7399 C Cartesian gradient
7403 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7405 vv(1)=pizda(1,1)-pizda(2,2)
7406 vv(2)=pizda(1,2)+pizda(2,1)
7407 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7408 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7409 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7416 C Contribution from graph II
7417 call transpose2(EE(1,1,k),auxmat(1,1))
7418 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7419 vv(1)=pizda(1,1)+pizda(2,2)
7420 vv(2)=pizda(2,1)-pizda(1,2)
7421 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7422 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7424 C Explicit gradient in virtual-dihedral angles.
7425 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7426 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7427 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7428 vv(1)=pizda(1,1)+pizda(2,2)
7429 vv(2)=pizda(2,1)-pizda(1,2)
7431 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7432 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7433 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7435 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7436 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7437 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7439 C Cartesian gradient
7443 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7445 vv(1)=pizda(1,1)+pizda(2,2)
7446 vv(2)=pizda(2,1)-pizda(1,2)
7447 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7448 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7449 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7458 C Parallel orientation
7459 C Contribution from graph III
7460 call transpose2(EUg(1,1,l),auxmat(1,1))
7461 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7462 vv(1)=pizda(1,1)-pizda(2,2)
7463 vv(2)=pizda(1,2)+pizda(2,1)
7464 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7465 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7467 C Explicit gradient in virtual-dihedral angles.
7468 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7469 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7470 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7471 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7472 vv(1)=pizda(1,1)-pizda(2,2)
7473 vv(2)=pizda(1,2)+pizda(2,1)
7474 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7475 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7476 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7477 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7478 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7479 vv(1)=pizda(1,1)-pizda(2,2)
7480 vv(2)=pizda(1,2)+pizda(2,1)
7481 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7482 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7483 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7484 C Cartesian gradient
7488 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7490 vv(1)=pizda(1,1)-pizda(2,2)
7491 vv(2)=pizda(1,2)+pizda(2,1)
7492 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7493 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7494 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7499 C Contribution from graph IV
7501 call transpose2(EE(1,1,l),auxmat(1,1))
7502 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7503 vv(1)=pizda(1,1)+pizda(2,2)
7504 vv(2)=pizda(2,1)-pizda(1,2)
7505 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7506 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7507 C Explicit gradient in virtual-dihedral angles.
7508 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7509 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7510 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7511 vv(1)=pizda(1,1)+pizda(2,2)
7512 vv(2)=pizda(2,1)-pizda(1,2)
7513 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7514 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7515 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7516 C Cartesian gradient
7520 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7522 vv(1)=pizda(1,1)+pizda(2,2)
7523 vv(2)=pizda(2,1)-pizda(1,2)
7524 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7525 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7526 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7532 C Antiparallel orientation
7533 C Contribution from graph III
7535 call transpose2(EUg(1,1,j),auxmat(1,1))
7536 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7537 vv(1)=pizda(1,1)-pizda(2,2)
7538 vv(2)=pizda(1,2)+pizda(2,1)
7539 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7540 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7542 C Explicit gradient in virtual-dihedral angles.
7543 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7544 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7545 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7546 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7547 vv(1)=pizda(1,1)-pizda(2,2)
7548 vv(2)=pizda(1,2)+pizda(2,1)
7549 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7550 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7551 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7552 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7553 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7554 vv(1)=pizda(1,1)-pizda(2,2)
7555 vv(2)=pizda(1,2)+pizda(2,1)
7556 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7557 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7558 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7559 C Cartesian gradient
7563 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7565 vv(1)=pizda(1,1)-pizda(2,2)
7566 vv(2)=pizda(1,2)+pizda(2,1)
7567 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7568 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7569 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7575 C Contribution from graph IV
7577 call transpose2(EE(1,1,j),auxmat(1,1))
7578 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7579 vv(1)=pizda(1,1)+pizda(2,2)
7580 vv(2)=pizda(2,1)-pizda(1,2)
7581 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7582 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7584 C Explicit gradient in virtual-dihedral angles.
7585 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7586 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7587 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7588 vv(1)=pizda(1,1)+pizda(2,2)
7589 vv(2)=pizda(2,1)-pizda(1,2)
7590 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7591 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7592 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7593 C Cartesian gradient
7597 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7599 vv(1)=pizda(1,1)+pizda(2,2)
7600 vv(2)=pizda(2,1)-pizda(1,2)
7601 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7602 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7603 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7610 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7611 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7612 cd write (2,*) 'ijkl',i,j,k,l
7613 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7614 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7616 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7617 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7618 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7619 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7621 if (j.lt.nres-1) then
7628 if (l.lt.nres-1) then
7638 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7639 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7640 C summed up outside the subrouine as for the other subroutines
7641 C handling long-range interactions. The old code is commented out
7642 C with "cgrad" to keep track of changes.
7644 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7645 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7646 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7647 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7648 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7649 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7650 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7651 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7652 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7653 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7655 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7656 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7657 cgrad ghalf=0.5d0*ggg1(ll)
7659 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7660 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7661 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7662 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7663 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7664 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7665 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7666 cgrad ghalf=0.5d0*ggg2(ll)
7668 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7669 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7670 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7671 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7672 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7673 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7679 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7680 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7685 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7686 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7692 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7697 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7701 cd write (2,*) iii,g_corr5_loc(iii)
7704 cd write (2,*) 'ekont',ekont
7705 cd write (iout,*) 'eello5',ekont*eel5
7708 c--------------------------------------------------------------------------
7709 double precision function eello6(i,j,k,l,jj,kk)
7710 implicit real*8 (a-h,o-z)
7711 include 'DIMENSIONS'
7712 include 'COMMON.IOUNITS'
7713 include 'COMMON.CHAIN'
7714 include 'COMMON.DERIV'
7715 include 'COMMON.INTERACT'
7716 include 'COMMON.CONTACTS'
7717 include 'COMMON.TORSION'
7718 include 'COMMON.VAR'
7719 include 'COMMON.GEO'
7720 include 'COMMON.FFIELD'
7721 double precision ggg1(3),ggg2(3)
7722 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7727 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7735 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7736 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7740 derx(lll,kkk,iii)=0.0d0
7744 cd eij=facont_hb(jj,i)
7745 cd ekl=facont_hb(kk,k)
7751 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7752 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7753 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7754 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7755 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7756 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7758 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7759 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7760 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7761 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7762 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7763 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7767 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7769 C If turn contributions are considered, they will be handled separately.
7770 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7771 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7772 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7773 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7774 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7775 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7776 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7779 if (j.lt.nres-1) then
7786 if (l.lt.nres-1) then
7794 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7795 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7796 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7797 cgrad ghalf=0.5d0*ggg1(ll)
7799 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7800 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7801 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7802 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7803 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7804 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7805 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7806 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7807 cgrad ghalf=0.5d0*ggg2(ll)
7808 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7810 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7811 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7812 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7813 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7814 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7815 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7821 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7822 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7827 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7828 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7834 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7839 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7843 cd write (2,*) iii,g_corr6_loc(iii)
7846 cd write (2,*) 'ekont',ekont
7847 cd write (iout,*) 'eello6',ekont*eel6
7850 c--------------------------------------------------------------------------
7851 double precision function eello6_graph1(i,j,k,l,imat,swap)
7852 implicit real*8 (a-h,o-z)
7853 include 'DIMENSIONS'
7854 include 'COMMON.IOUNITS'
7855 include 'COMMON.CHAIN'
7856 include 'COMMON.DERIV'
7857 include 'COMMON.INTERACT'
7858 include 'COMMON.CONTACTS'
7859 include 'COMMON.TORSION'
7860 include 'COMMON.VAR'
7861 include 'COMMON.GEO'
7862 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7866 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7868 C Parallel Antiparallel C
7874 C \ j|/k\| / \ |/k\|l / C
7879 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7880 itk=itype2loc(itype(k))
7881 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7882 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7883 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7884 call transpose2(EUgC(1,1,k),auxmat(1,1))
7885 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7886 vv1(1)=pizda1(1,1)-pizda1(2,2)
7887 vv1(2)=pizda1(1,2)+pizda1(2,1)
7888 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7889 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
7890 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
7891 s5=scalar2(vv(1),Dtobr2(1,i))
7892 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7893 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7895 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7896 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7897 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7898 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7899 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7900 & +scalar2(vv(1),Dtobr2der(1,i)))
7901 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7902 vv1(1)=pizda1(1,1)-pizda1(2,2)
7903 vv1(2)=pizda1(1,2)+pizda1(2,1)
7904 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
7905 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
7907 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7908 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7909 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7910 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7911 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7913 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7914 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7915 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7916 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7917 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7919 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7920 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7921 vv1(1)=pizda1(1,1)-pizda1(2,2)
7922 vv1(2)=pizda1(1,2)+pizda1(2,1)
7923 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7924 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7925 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7926 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7935 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7936 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7937 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7938 call transpose2(EUgC(1,1,k),auxmat(1,1))
7939 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7941 vv1(1)=pizda1(1,1)-pizda1(2,2)
7942 vv1(2)=pizda1(1,2)+pizda1(2,1)
7943 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7944 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
7945 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
7946 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
7947 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
7948 s5=scalar2(vv(1),Dtobr2(1,i))
7949 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7956 c----------------------------------------------------------------------------
7957 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7958 implicit real*8 (a-h,o-z)
7959 include 'DIMENSIONS'
7960 include 'COMMON.IOUNITS'
7961 include 'COMMON.CHAIN'
7962 include 'COMMON.DERIV'
7963 include 'COMMON.INTERACT'
7964 include 'COMMON.CONTACTS'
7965 include 'COMMON.TORSION'
7966 include 'COMMON.VAR'
7967 include 'COMMON.GEO'
7969 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7970 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7973 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7975 C Parallel Antiparallel C
7981 C \ j|/k\| \ |/k\|l C
7986 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7987 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7988 C AL 7/4/01 s1 would occur in the sixth-order moment,
7989 C but not in a cluster cumulant
7991 s1=dip(1,jj,i)*dip(1,kk,k)
7993 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7994 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7995 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7996 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7997 call transpose2(EUg(1,1,k),auxmat(1,1))
7998 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7999 vv(1)=pizda(1,1)-pizda(2,2)
8000 vv(2)=pizda(1,2)+pizda(2,1)
8001 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8002 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8004 eello6_graph2=-(s1+s2+s3+s4)
8006 eello6_graph2=-(s2+s3+s4)
8009 C Derivatives in gamma(i-1)
8013 s1=dipderg(1,jj,i)*dip(1,kk,k)
8015 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8016 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8017 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8018 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8020 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8022 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8024 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8026 C Derivatives in gamma(k-1)
8028 s1=dip(1,jj,i)*dipderg(1,kk,k)
8030 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8031 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8032 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8033 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8034 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8035 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8036 vv(1)=pizda(1,1)-pizda(2,2)
8037 vv(2)=pizda(1,2)+pizda(2,1)
8038 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8040 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8042 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8044 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8045 C Derivatives in gamma(j-1) or gamma(l-1)
8048 s1=dipderg(3,jj,i)*dip(1,kk,k)
8050 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8051 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8052 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8053 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8054 vv(1)=pizda(1,1)-pizda(2,2)
8055 vv(2)=pizda(1,2)+pizda(2,1)
8056 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8059 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8061 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8064 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8065 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8067 C Derivatives in gamma(l-1) or gamma(j-1)
8070 s1=dip(1,jj,i)*dipderg(3,kk,k)
8072 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8073 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8074 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8075 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8076 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8077 vv(1)=pizda(1,1)-pizda(2,2)
8078 vv(2)=pizda(1,2)+pizda(2,1)
8079 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8082 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8084 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8087 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8088 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8090 C Cartesian derivatives.
8092 write (2,*) 'In eello6_graph2'
8094 write (2,*) 'iii=',iii
8096 write (2,*) 'kkk=',kkk
8098 write (2,'(3(2f10.5),5x)')
8099 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8109 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8111 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8114 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8116 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8117 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8119 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8120 call transpose2(EUg(1,1,k),auxmat(1,1))
8121 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8123 vv(1)=pizda(1,1)-pizda(2,2)
8124 vv(2)=pizda(1,2)+pizda(2,1)
8125 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8126 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8128 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8130 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8133 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8135 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8143 c----------------------------------------------------------------------------
8144 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8145 implicit real*8 (a-h,o-z)
8146 include 'DIMENSIONS'
8147 include 'COMMON.IOUNITS'
8148 include 'COMMON.CHAIN'
8149 include 'COMMON.DERIV'
8150 include 'COMMON.INTERACT'
8151 include 'COMMON.CONTACTS'
8152 include 'COMMON.TORSION'
8153 include 'COMMON.VAR'
8154 include 'COMMON.GEO'
8155 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8157 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8159 C Parallel Antiparallel C
8165 C j|/k\| / |/k\|l / C
8170 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8172 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8173 C energy moment and not to the cluster cumulant.
8174 iti=itortyp(itype(i))
8175 if (j.lt.nres-1) then
8176 itj1=itype2loc(itype(j+1))
8180 itk=itype2loc(itype(k))
8181 itk1=itype2loc(itype(k+1))
8182 if (l.lt.nres-1) then
8183 itl1=itype2loc(itype(l+1))
8188 s1=dip(4,jj,i)*dip(4,kk,k)
8190 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8191 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8192 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8193 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8194 call transpose2(EE(1,1,k),auxmat(1,1))
8195 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8196 vv(1)=pizda(1,1)+pizda(2,2)
8197 vv(2)=pizda(2,1)-pizda(1,2)
8198 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8199 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8200 cd & "sum",-(s2+s3+s4)
8202 eello6_graph3=-(s1+s2+s3+s4)
8204 eello6_graph3=-(s2+s3+s4)
8207 C Derivatives in gamma(k-1)
8209 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8210 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8211 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8212 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8213 C Derivatives in gamma(l-1)
8214 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8215 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8216 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8217 vv(1)=pizda(1,1)+pizda(2,2)
8218 vv(2)=pizda(2,1)-pizda(1,2)
8219 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8220 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8221 C Cartesian derivatives.
8227 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8229 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8232 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8234 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8235 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8237 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8238 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8240 vv(1)=pizda(1,1)+pizda(2,2)
8241 vv(2)=pizda(2,1)-pizda(1,2)
8242 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8244 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8246 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8249 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8251 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8253 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8260 c----------------------------------------------------------------------------
8261 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8262 implicit real*8 (a-h,o-z)
8263 include 'DIMENSIONS'
8264 include 'COMMON.IOUNITS'
8265 include 'COMMON.CHAIN'
8266 include 'COMMON.DERIV'
8267 include 'COMMON.INTERACT'
8268 include 'COMMON.CONTACTS'
8269 include 'COMMON.TORSION'
8270 include 'COMMON.VAR'
8271 include 'COMMON.GEO'
8272 include 'COMMON.FFIELD'
8273 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8274 & auxvec1(2),auxmat1(2,2)
8276 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8278 C Parallel Antiparallel C
8284 C \ j|/k\| \ |/k\|l C
8289 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8291 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8292 C energy moment and not to the cluster cumulant.
8293 cd write (2,*) 'eello_graph4: wturn6',wturn6
8294 iti=itype2loc(itype(i))
8295 itj=itype2loc(itype(j))
8296 if (j.lt.nres-1) then
8297 itj1=itype2loc(itype(j+1))
8301 itk=itype2loc(itype(k))
8302 if (k.lt.nres-1) then
8303 itk1=itype2loc(itype(k+1))
8307 itl=itype2loc(itype(l))
8308 if (l.lt.nres-1) then
8309 itl1=itype2loc(itype(l+1))
8313 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8314 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8315 cd & ' itl',itl,' itl1',itl1
8318 s1=dip(3,jj,i)*dip(3,kk,k)
8320 s1=dip(2,jj,j)*dip(2,kk,l)
8323 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8324 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8326 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8327 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8329 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8330 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8332 call transpose2(EUg(1,1,k),auxmat(1,1))
8333 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8334 vv(1)=pizda(1,1)-pizda(2,2)
8335 vv(2)=pizda(2,1)+pizda(1,2)
8336 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8337 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8339 eello6_graph4=-(s1+s2+s3+s4)
8341 eello6_graph4=-(s2+s3+s4)
8343 C Derivatives in gamma(i-1)
8348 s1=dipderg(2,jj,i)*dip(3,kk,k)
8350 s1=dipderg(4,jj,j)*dip(2,kk,l)
8353 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8355 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8356 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8358 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8359 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8361 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8362 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8363 cd write (2,*) 'turn6 derivatives'
8365 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8367 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8371 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8373 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8377 C Derivatives in gamma(k-1)
8380 s1=dip(3,jj,i)*dipderg(2,kk,k)
8382 s1=dip(2,jj,j)*dipderg(4,kk,l)
8385 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8386 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8388 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8389 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8391 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8392 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8394 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8395 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8396 vv(1)=pizda(1,1)-pizda(2,2)
8397 vv(2)=pizda(2,1)+pizda(1,2)
8398 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8399 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8401 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8403 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8407 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8409 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8412 C Derivatives in gamma(j-1) or gamma(l-1)
8413 if (l.eq.j+1 .and. l.gt.1) then
8414 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8415 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8416 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8417 vv(1)=pizda(1,1)-pizda(2,2)
8418 vv(2)=pizda(2,1)+pizda(1,2)
8419 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8420 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8421 else if (j.gt.1) then
8422 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8423 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8424 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8425 vv(1)=pizda(1,1)-pizda(2,2)
8426 vv(2)=pizda(2,1)+pizda(1,2)
8427 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8428 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8429 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8431 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8434 C Cartesian derivatives.
8441 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8443 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8447 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8449 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8453 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8455 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8457 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8458 & b1(1,j+1),auxvec(1))
8459 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8461 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8462 & b1(1,l+1),auxvec(1))
8463 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8465 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8467 vv(1)=pizda(1,1)-pizda(2,2)
8468 vv(2)=pizda(2,1)+pizda(1,2)
8469 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8471 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8473 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8476 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8479 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8482 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8484 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8486 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8490 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8492 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8495 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8497 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8506 c----------------------------------------------------------------------------
8507 double precision function eello_turn6(i,jj,kk)
8508 implicit real*8 (a-h,o-z)
8509 include 'DIMENSIONS'
8510 include 'COMMON.IOUNITS'
8511 include 'COMMON.CHAIN'
8512 include 'COMMON.DERIV'
8513 include 'COMMON.INTERACT'
8514 include 'COMMON.CONTACTS'
8515 include 'COMMON.TORSION'
8516 include 'COMMON.VAR'
8517 include 'COMMON.GEO'
8518 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8519 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8521 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8522 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8523 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8524 C the respective energy moment and not to the cluster cumulant.
8533 iti=itype2loc(itype(i))
8534 itk=itype2loc(itype(k))
8535 itk1=itype2loc(itype(k+1))
8536 itl=itype2loc(itype(l))
8537 itj=itype2loc(itype(j))
8538 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8539 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8540 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8545 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8547 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8551 derx_turn(lll,kkk,iii)=0.0d0
8558 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8560 cd write (2,*) 'eello6_5',eello6_5
8562 call transpose2(AEA(1,1,1),auxmat(1,1))
8563 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8564 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8565 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8567 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8568 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8569 s2 = scalar2(b1(1,k),vtemp1(1))
8571 call transpose2(AEA(1,1,2),atemp(1,1))
8572 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8573 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8574 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8576 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8577 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8578 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8580 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8581 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8582 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8583 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8584 ss13 = scalar2(b1(1,k),vtemp4(1))
8585 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8587 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8593 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8594 C Derivatives in gamma(i+2)
8599 call transpose2(AEA(1,1,1),auxmatd(1,1))
8600 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8601 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8602 call transpose2(AEAderg(1,1,2),atempd(1,1))
8603 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8604 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8606 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8607 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8608 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8614 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8615 C Derivatives in gamma(i+3)
8617 call transpose2(AEA(1,1,1),auxmatd(1,1))
8618 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8619 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8620 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8622 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8623 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8624 s2d = scalar2(b1(1,k),vtemp1d(1))
8626 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8627 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8629 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8631 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8632 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8633 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8641 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8642 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8644 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8645 & -0.5d0*ekont*(s2d+s12d)
8647 C Derivatives in gamma(i+4)
8648 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8649 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8650 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8652 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8653 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8654 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8662 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8664 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8666 C Derivatives in gamma(i+5)
8668 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8669 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8670 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8672 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8673 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8674 s2d = scalar2(b1(1,k),vtemp1d(1))
8676 call transpose2(AEA(1,1,2),atempd(1,1))
8677 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8678 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8680 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8681 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8683 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8684 ss13d = scalar2(b1(1,k),vtemp4d(1))
8685 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8693 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8694 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8696 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8697 & -0.5d0*ekont*(s2d+s12d)
8699 C Cartesian derivatives
8704 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8705 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8706 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8708 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8709 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8711 s2d = scalar2(b1(1,k),vtemp1d(1))
8713 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8714 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8715 s8d = -(atempd(1,1)+atempd(2,2))*
8716 & scalar2(cc(1,1,l),vtemp2(1))
8718 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8720 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8721 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8728 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8731 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8735 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8736 & - 0.5d0*(s8d+s12d)
8738 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8747 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8749 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8750 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8751 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8752 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8753 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8755 ss13d = scalar2(b1(1,k),vtemp4d(1))
8756 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8757 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8761 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8762 cd & 16*eel_turn6_num
8764 if (j.lt.nres-1) then
8771 if (l.lt.nres-1) then
8779 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8780 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8781 cgrad ghalf=0.5d0*ggg1(ll)
8783 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8784 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8785 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8786 & +ekont*derx_turn(ll,2,1)
8787 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8788 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8789 & +ekont*derx_turn(ll,4,1)
8790 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8791 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8792 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8793 cgrad ghalf=0.5d0*ggg2(ll)
8795 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8796 & +ekont*derx_turn(ll,2,2)
8797 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8798 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8799 & +ekont*derx_turn(ll,4,2)
8800 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8801 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8802 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8807 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8812 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8818 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8823 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8827 cd write (2,*) iii,g_corr6_loc(iii)
8830 eello_turn6=ekont*eel_turn6
8831 cd write (2,*) 'ekont',ekont
8832 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8836 crc-------------------------------------------------
8837 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8838 subroutine Eliptransfer(eliptran)
8839 implicit real*8 (a-h,o-z)
8840 include 'DIMENSIONS'
8841 include 'COMMON.GEO'
8842 include 'COMMON.VAR'
8843 include 'COMMON.LOCAL'
8844 include 'COMMON.CHAIN'
8845 include 'COMMON.DERIV'
8846 include 'COMMON.INTERACT'
8847 include 'COMMON.IOUNITS'
8848 include 'COMMON.CALC'
8849 include 'COMMON.CONTROL'
8850 include 'COMMON.SPLITELE'
8851 include 'COMMON.SBRIDGE'
8852 C this is done by Adasko
8856 C--bordliptop-- buffore starts
8857 C--bufliptop--- here true lipid starts
8859 C--buflipbot--- lipid ends buffore starts
8860 C--bordlipbot--buffore ends
8864 if (itype(i).eq.ntyp1) cycle
8866 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8867 if (positi.le.0) positi=positi+boxzsize
8869 C first for peptide groups
8870 c for each residue check if it is in lipid or lipid water border area
8871 if ((positi.gt.bordlipbot)
8872 &.and.(positi.lt.bordliptop)) then
8873 C the energy transfer exist
8874 if (positi.lt.buflipbot) then
8875 C what fraction I am in
8877 & ((positi-bordlipbot)/lipbufthick)
8878 C lipbufthick is thickenes of lipid buffore
8879 sslip=sscalelip(fracinbuf)
8880 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8881 eliptran=eliptran+sslip*pepliptran
8882 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8883 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8884 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8885 elseif (positi.gt.bufliptop) then
8886 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8887 sslip=sscalelip(fracinbuf)
8888 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8889 eliptran=eliptran+sslip*pepliptran
8890 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8891 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8892 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8893 C print *, "doing sscalefor top part"
8894 C print *,i,sslip,fracinbuf,ssgradlip
8896 eliptran=eliptran+pepliptran
8897 C print *,"I am in true lipid"
8900 C eliptran=elpitran+0.0 ! I am in water
8903 C print *, "nic nie bylo w lipidzie?"
8904 C now multiply all by the peptide group transfer factor
8905 C eliptran=eliptran*pepliptran
8906 C now the same for side chains
8909 if (itype(i).eq.ntyp1) cycle
8910 positi=(mod(c(3,i+nres),boxzsize))
8911 if (positi.le.0) positi=positi+boxzsize
8912 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8913 c for each residue check if it is in lipid or lipid water border area
8914 C respos=mod(c(3,i+nres),boxzsize)
8915 C print *,positi,bordlipbot,buflipbot
8916 if ((positi.gt.bordlipbot)
8917 & .and.(positi.lt.bordliptop)) then
8918 C the energy transfer exist
8919 if (positi.lt.buflipbot) then
8921 & ((positi-bordlipbot)/lipbufthick)
8922 C lipbufthick is thickenes of lipid buffore
8923 sslip=sscalelip(fracinbuf)
8924 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8925 eliptran=eliptran+sslip*liptranene(itype(i))
8926 gliptranx(3,i)=gliptranx(3,i)
8927 &+ssgradlip*liptranene(itype(i))
8928 gliptranc(3,i-1)= gliptranc(3,i-1)
8929 &+ssgradlip*liptranene(itype(i))
8930 C print *,"doing sccale for lower part"
8931 elseif (positi.gt.bufliptop) then
8933 &((bordliptop-positi)/lipbufthick)
8934 sslip=sscalelip(fracinbuf)
8935 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8936 eliptran=eliptran+sslip*liptranene(itype(i))
8937 gliptranx(3,i)=gliptranx(3,i)
8938 &+ssgradlip*liptranene(itype(i))
8939 gliptranc(3,i-1)= gliptranc(3,i-1)
8940 &+ssgradlip*liptranene(itype(i))
8941 C print *, "doing sscalefor top part",sslip,fracinbuf
8943 eliptran=eliptran+liptranene(itype(i))
8944 C print *,"I am in true lipid"
8946 endif ! if in lipid or buffor
8948 C eliptran=elpitran+0.0 ! I am in water
8954 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8956 SUBROUTINE MATVEC2(A1,V1,V2)
8957 implicit real*8 (a-h,o-z)
8958 include 'DIMENSIONS'
8959 DIMENSION A1(2,2),V1(2),V2(2)
8963 c 3 VI=VI+A1(I,K)*V1(K)
8967 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8968 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8973 C---------------------------------------
8974 SUBROUTINE MATMAT2(A1,A2,A3)
8975 implicit real*8 (a-h,o-z)
8976 include 'DIMENSIONS'
8977 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8978 c DIMENSION AI3(2,2)
8982 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8988 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8989 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8990 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8991 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8999 c-------------------------------------------------------------------------
9000 double precision function scalar2(u,v)
9002 double precision u(2),v(2)
9005 scalar2=u(1)*v(1)+u(2)*v(2)
9009 C-----------------------------------------------------------------------------
9011 subroutine transpose2(a,at)
9013 double precision a(2,2),at(2,2)
9020 c--------------------------------------------------------------------------
9021 subroutine transpose(n,a,at)
9024 double precision a(n,n),at(n,n)
9032 C---------------------------------------------------------------------------
9033 subroutine prodmat3(a1,a2,kk,transp,prod)
9036 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9038 crc double precision auxmat(2,2),prod_(2,2)
9041 crc call transpose2(kk(1,1),auxmat(1,1))
9042 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9043 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9045 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9046 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9047 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9048 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9049 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9050 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9051 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9052 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9055 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9056 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9058 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9059 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9060 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9061 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9062 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9063 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9064 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9065 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9068 c call transpose2(a2(1,1),a2t(1,1))
9071 crc print *,((prod_(i,j),i=1,2),j=1,2)
9072 crc print *,((prod(i,j),i=1,2),j=1,2)
9076 C-----------------------------------------------------------------------------
9077 double precision function scalar(u,v)
9079 double precision u(3),v(3)
9089 C-----------------------------------------------------------------------
9090 double precision function sscale(r)
9091 double precision r,gamm
9092 include "COMMON.SPLITELE"
9093 if(r.lt.r_cut-rlamb) then
9095 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9096 gamm=(r-(r_cut-rlamb))/rlamb
9097 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9103 C-----------------------------------------------------------------------
9104 C-----------------------------------------------------------------------
9105 double precision function sscagrad(r)
9106 double precision r,gamm
9107 include "COMMON.SPLITELE"
9108 if(r.lt.r_cut-rlamb) then
9110 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9111 gamm=(r-(r_cut-rlamb))/rlamb
9112 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9118 C-----------------------------------------------------------------------
9119 C-----------------------------------------------------------------------
9120 double precision function sscalelip(r)
9121 double precision r,gamm
9122 include "COMMON.SPLITELE"
9123 C if(r.lt.r_cut-rlamb) then
9125 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9126 C gamm=(r-(r_cut-rlamb))/rlamb
9127 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9133 C-----------------------------------------------------------------------
9134 double precision function sscagradlip(r)
9135 double precision r,gamm
9136 include "COMMON.SPLITELE"
9137 C if(r.lt.r_cut-rlamb) then
9139 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9140 C gamm=(r-(r_cut-rlamb))/rlamb
9141 sscagradlip=r*(6*r-6.0d0)
9148 C-----------------------------------------------------------------------
9149 subroutine set_shield_fac
9150 implicit real*8 (a-h,o-z)
9151 include 'DIMENSIONS'
9152 include 'COMMON.CHAIN'
9153 include 'COMMON.DERIV'
9154 include 'COMMON.IOUNITS'
9155 include 'COMMON.SHIELD'
9156 include 'COMMON.INTERACT'
9157 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9158 double precision div77_81/0.974996043d0/,
9159 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9161 C the vector between center of side_chain and peptide group
9162 double precision pep_side(3),long,side_calf(3),
9163 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9164 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9165 C the line belowe needs to be changed for FGPROC>1
9167 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9169 Cif there two consequtive dummy atoms there is no peptide group between them
9170 C the line below has to be changed for FGPROC>1
9173 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9177 C first lets set vector conecting the ithe side-chain with kth side-chain
9178 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9180 C and vector conecting the side-chain with its proper calfa
9181 side_calf(j)=c(j,k+nres)-c(j,k)
9182 C side_calf(j)=2.0d0
9183 pept_group(j)=c(j,i)-c(j,i+1)
9184 C lets have their lenght
9185 dist_pep_side=pep_side(j)**2+dist_pep_side
9186 dist_side_calf=dist_side_calf+side_calf(j)**2
9187 dist_pept_group=dist_pept_group+pept_group(j)**2
9189 dist_pep_side=dsqrt(dist_pep_side)
9190 dist_pept_group=dsqrt(dist_pept_group)
9191 dist_side_calf=dsqrt(dist_side_calf)
9193 pep_side_norm(j)=pep_side(j)/dist_pep_side
9194 side_calf_norm(j)=dist_side_calf
9196 C now sscale fraction
9197 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9198 C print *,buff_shield,"buff"
9200 if (sh_frac_dist.le.0.0) cycle
9201 C If we reach here it means that this side chain reaches the shielding sphere
9202 C Lets add him to the list for gradient
9203 ishield_list(i)=ishield_list(i)+1
9204 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9205 C this list is essential otherwise problem would be O3
9206 shield_list(ishield_list(i),i)=k
9207 C Lets have the sscale value
9208 if (sh_frac_dist.gt.1.0) then
9209 scale_fac_dist=1.0d0
9211 sh_frac_dist_grad(j)=0.0d0
9214 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9215 & *(2.0*sh_frac_dist-3.0d0)
9216 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9217 & /dist_pep_side/buff_shield*0.5
9218 C remember for the final gradient multiply sh_frac_dist_grad(j)
9219 C for side_chain by factor -2 !
9221 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9222 C print *,"jestem",scale_fac_dist,fac_help_scale,
9223 C & sh_frac_dist_grad(j)
9226 C if ((i.eq.3).and.(k.eq.2)) then
9227 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9231 C this is what is now we have the distance scaling now volume...
9232 short=short_r_sidechain(itype(k))
9233 long=long_r_sidechain(itype(k))
9234 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9237 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9240 costhet_grad(j)=costhet_fac*pep_side(j)
9242 C remember for the final gradient multiply costhet_grad(j)
9243 C for side_chain by factor -2 !
9244 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9245 C pep_side0pept_group is vector multiplication
9246 pep_side0pept_group=0.0
9248 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9250 cosalfa=(pep_side0pept_group/
9251 & (dist_pep_side*dist_side_calf))
9252 fac_alfa_sin=1.0-cosalfa**2
9253 fac_alfa_sin=dsqrt(fac_alfa_sin)
9254 rkprim=fac_alfa_sin*(long-short)+short
9256 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9257 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9260 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9261 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9262 &*(long-short)/fac_alfa_sin*cosalfa/
9263 &((dist_pep_side*dist_side_calf))*
9264 &((side_calf(j))-cosalfa*
9265 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9267 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9268 &*(long-short)/fac_alfa_sin*cosalfa
9269 &/((dist_pep_side*dist_side_calf))*
9271 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9274 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9277 C now the gradient...
9278 C grad_shield is gradient of Calfa for peptide groups
9279 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9281 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9282 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9284 grad_shield(j,i)=grad_shield(j,i)
9285 C gradient po skalowaniu
9286 & +(sh_frac_dist_grad(j)
9287 C gradient po costhet
9288 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9289 &-scale_fac_dist*(cosphi_grad_long(j))
9290 &/(1.0-cosphi) )*div77_81
9292 C grad_shield_side is Cbeta sidechain gradient
9293 grad_shield_side(j,ishield_list(i),i)=
9294 & (sh_frac_dist_grad(j)*(-2.0d0)
9295 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9296 & +scale_fac_dist*(cosphi_grad_long(j))
9297 & *2.0d0/(1.0-cosphi))
9298 & *div77_81*VofOverlap
9300 grad_shield_loc(j,ishield_list(i),i)=
9301 & scale_fac_dist*cosphi_grad_loc(j)
9302 & *2.0d0/(1.0-cosphi)
9303 & *div77_81*VofOverlap
9305 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9307 fac_shield(i)=VolumeTotal*div77_81+div4_81
9308 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9312 C--------------------------------------------------------------------------
9313 C first for shielding is setting of function of side-chains
9314 subroutine set_shield_fac2
9315 implicit real*8 (a-h,o-z)
9316 include 'DIMENSIONS'
9317 include 'COMMON.CHAIN'
9318 include 'COMMON.DERIV'
9319 include 'COMMON.IOUNITS'
9320 include 'COMMON.SHIELD'
9321 include 'COMMON.INTERACT'
9322 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9323 double precision div77_81/0.974996043d0/,
9324 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9326 C the vector between center of side_chain and peptide group
9327 double precision pep_side(3),long,side_calf(3),
9328 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9329 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9330 C the line belowe needs to be changed for FGPROC>1
9332 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9334 Cif there two consequtive dummy atoms there is no peptide group between them
9335 C the line below has to be changed for FGPROC>1
9338 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9342 C first lets set vector conecting the ithe side-chain with kth side-chain
9343 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9345 C and vector conecting the side-chain with its proper calfa
9346 side_calf(j)=c(j,k+nres)-c(j,k)
9347 C side_calf(j)=2.0d0
9348 pept_group(j)=c(j,i)-c(j,i+1)
9349 C lets have their lenght
9350 dist_pep_side=pep_side(j)**2+dist_pep_side
9351 dist_side_calf=dist_side_calf+side_calf(j)**2
9352 dist_pept_group=dist_pept_group+pept_group(j)**2
9354 dist_pep_side=dsqrt(dist_pep_side)
9355 dist_pept_group=dsqrt(dist_pept_group)
9356 dist_side_calf=dsqrt(dist_side_calf)
9358 pep_side_norm(j)=pep_side(j)/dist_pep_side
9359 side_calf_norm(j)=dist_side_calf
9361 C now sscale fraction
9362 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9363 C print *,buff_shield,"buff"
9365 if (sh_frac_dist.le.0.0) cycle
9366 C If we reach here it means that this side chain reaches the shielding sphere
9367 C Lets add him to the list for gradient
9368 ishield_list(i)=ishield_list(i)+1
9369 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9370 C this list is essential otherwise problem would be O3
9371 shield_list(ishield_list(i),i)=k
9372 C Lets have the sscale value
9373 if (sh_frac_dist.gt.1.0) then
9374 scale_fac_dist=1.0d0
9376 sh_frac_dist_grad(j)=0.0d0
9379 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9380 & *(2.0d0*sh_frac_dist-3.0d0)
9381 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9382 & /dist_pep_side/buff_shield*0.5d0
9383 C remember for the final gradient multiply sh_frac_dist_grad(j)
9384 C for side_chain by factor -2 !
9386 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9387 C sh_frac_dist_grad(j)=0.0d0
9388 C scale_fac_dist=1.0d0
9389 C print *,"jestem",scale_fac_dist,fac_help_scale,
9390 C & sh_frac_dist_grad(j)
9393 C this is what is now we have the distance scaling now volume...
9394 short=short_r_sidechain(itype(k))
9395 long=long_r_sidechain(itype(k))
9396 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9397 sinthet=short/dist_pep_side*costhet
9401 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9402 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9403 C & -short/dist_pep_side**2/costhet)
9406 costhet_grad(j)=costhet_fac*pep_side(j)
9408 C remember for the final gradient multiply costhet_grad(j)
9409 C for side_chain by factor -2 !
9410 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9411 C pep_side0pept_group is vector multiplication
9412 pep_side0pept_group=0.0d0
9414 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9416 cosalfa=(pep_side0pept_group/
9417 & (dist_pep_side*dist_side_calf))
9418 fac_alfa_sin=1.0d0-cosalfa**2
9419 fac_alfa_sin=dsqrt(fac_alfa_sin)
9420 rkprim=fac_alfa_sin*(long-short)+short
9424 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9426 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9427 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9431 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9432 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9433 &*(long-short)/fac_alfa_sin*cosalfa/
9434 &((dist_pep_side*dist_side_calf))*
9435 &((side_calf(j))-cosalfa*
9436 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9437 C cosphi_grad_long(j)=0.0d0
9438 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9439 &*(long-short)/fac_alfa_sin*cosalfa
9440 &/((dist_pep_side*dist_side_calf))*
9442 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9443 C cosphi_grad_loc(j)=0.0d0
9445 C print *,sinphi,sinthet
9446 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9449 C now the gradient...
9451 grad_shield(j,i)=grad_shield(j,i)
9452 C gradient po skalowaniu
9453 & +(sh_frac_dist_grad(j)*VofOverlap
9454 C gradient po costhet
9455 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9456 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9457 & sinphi/sinthet*costhet*costhet_grad(j)
9458 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9460 C grad_shield_side is Cbeta sidechain gradient
9461 grad_shield_side(j,ishield_list(i),i)=
9462 & (sh_frac_dist_grad(j)*(-2.0d0)
9464 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9465 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9466 & sinphi/sinthet*costhet*costhet_grad(j)
9467 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9470 grad_shield_loc(j,ishield_list(i),i)=
9471 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9472 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9473 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9477 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9479 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9480 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9481 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9485 C--------------------------------------------------------------------------
9486 double precision function tschebyshev(m,n,x,y)
9488 include "DIMENSIONS"
9490 double precision x(n),y,yy(0:maxvar),aux
9491 c Tschebyshev polynomial. Note that the first term is omitted
9492 c m=0: the constant term is included
9493 c m=1: the constant term is not included
9497 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9506 C--------------------------------------------------------------------------
9507 double precision function gradtschebyshev(m,n,x,y)
9509 include "DIMENSIONS"
9511 double precision x(n+1),y,yy(0:maxvar),aux
9512 c Tschebyshev polynomial. Note that the first term is omitted
9513 c m=0: the constant term is included
9514 c m=1: the constant term is not included
9518 yy(i)=2*y*yy(i-1)-yy(i-2)
9522 aux=aux+x(i+1)*yy(i)*(i+1)
9523 C print *, x(i+1),yy(i),i