1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 include 'COMMON.SHIELD'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
50 C Calculate electrostatic (H-bonding) energy of the main chain.
53 C write(iout,*) "shield_mode",shield_mode,ethetacnstr
54 if (shield_mode.eq.1) then
56 else if (shield_mode.eq.2) then
59 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
61 C Calculate excluded-volume interaction energy between peptide groups
64 call escp(evdw2,evdw2_14)
66 c Calculate the bond-stretching energy
69 c write (iout,*) "estr",estr
71 C Calculate the disulfide-bridge and other energy and the contributions
72 C from other distance constraints.
73 cd print *,'Calling EHPB'
75 cd print *,'EHPB exitted succesfully.'
77 C Calculate the virtual-bond-angle energy.
79 call ebend(ebe,ethetacnstr)
80 cd print *,'Bend energy finished.'
82 C Calculate the SC local energy.
85 cd print *,'SCLOC energy finished.'
87 C Calculate the virtual-bond torsional energy.
89 cd print *,'nterm=',nterm
90 call etor(etors,edihcnstr,fact(1))
92 C 6/23/01 Calculate double-torsional energy
94 call etor_d(etors_d,fact(2))
96 C 21/5/07 Calculate local sicdechain correlation energy
98 call eback_sc_corr(esccor)
100 C 12/1/95 Multi-body terms
104 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
105 & .or. wturn6.gt.0.0d0) then
106 c print *,"calling multibody_eello"
107 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
108 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
109 c print *,ecorr,ecorr5,ecorr6,eturn6
111 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
112 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
114 C write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
116 if (shield_mode.gt.0) then
117 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
119 & +fact(1)*wvdwpp*evdw1
120 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
121 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
122 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
123 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
124 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
125 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
126 C & +wliptran*eliptran
128 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
130 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
131 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
132 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
133 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
134 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
135 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
136 C & +wliptran*eliptran
139 if (shield_mode.gt.0) then
140 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
141 & +welec*fact(1)*(ees+evdw1)
142 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
143 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
144 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
145 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
146 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
147 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
148 C & +wliptran*eliptran
150 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
151 & +welec*fact(1)*(ees+evdw1)
152 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
153 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
154 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
155 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
156 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
157 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
158 C & +wliptran*eliptran
165 energia(2)=evdw2-evdw2_14
182 energia(8)=eello_turn3
183 energia(9)=eello_turn4
192 energia(20)=edihcnstr
194 energia(24)=ethetacnstr
198 if (isnan(etot).ne.0) energia(0)=1.0d+99
200 if (isnan(etot)) energia(0)=1.0d+99
205 idumm=proc_proc(etot,i)
207 call proc_proc(etot,i)
209 if(i.eq.1)energia(0)=1.0d+99
216 C Sum up the components of the Cartesian gradient.
221 if (shield_mode.eq.0) then
222 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
223 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
225 & wstrain*ghpbc(j,i)+
226 & wcorr*fact(3)*gradcorr(j,i)+
227 & wel_loc*fact(2)*gel_loc(j,i)+
228 & wturn3*fact(2)*gcorr3_turn(j,i)+
229 & wturn4*fact(3)*gcorr4_turn(j,i)+
230 & wcorr5*fact(4)*gradcorr5(j,i)+
231 & wcorr6*fact(5)*gradcorr6(j,i)+
232 & wturn6*fact(5)*gcorr6_turn(j,i)+
233 & wsccor*fact(2)*gsccorc(j,i)
234 & +wliptran*gliptranc(j,i)
235 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
237 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
238 & wsccor*fact(2)*gsccorx(j,i)
239 & +wliptran*gliptranx(j,i)
241 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
242 & +fact(1)*wscp*gvdwc_scp(j,i)+
243 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
245 & wstrain*ghpbc(j,i)+
246 & wcorr*fact(3)*gradcorr(j,i)+
247 & wel_loc*fact(2)*gel_loc(j,i)+
248 & wturn3*fact(2)*gcorr3_turn(j,i)+
249 & wturn4*fact(3)*gcorr4_turn(j,i)+
250 & wcorr5*fact(4)*gradcorr5(j,i)+
251 & wcorr6*fact(5)*gradcorr6(j,i)+
252 & wturn6*fact(5)*gcorr6_turn(j,i)+
253 & wsccor*fact(2)*gsccorc(j,i)
254 & +wliptran*gliptranc(j,i)
255 & +welec*gshieldc(j,i)
256 & +welec*gshieldc_loc(j,i)
257 & +wcorr*gshieldc_ec(j,i)
258 & +wcorr*gshieldc_loc_ec(j,i)
259 & +wturn3*gshieldc_t3(j,i)
260 & +wturn3*gshieldc_loc_t3(j,i)
261 & +wturn4*gshieldc_t4(j,i)
262 & +wturn4*gshieldc_loc_t4(j,i)
263 & +wel_loc*gshieldc_ll(j,i)
264 & +wel_loc*gshieldc_loc_ll(j,i)
266 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
267 & +fact(1)*wscp*gradx_scp(j,i)+
269 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
270 & wsccor*fact(2)*gsccorx(j,i)
271 & +wliptran*gliptranx(j,i)
272 & +welec*gshieldx(j,i)
273 & +wcorr*gshieldx_ec(j,i)
274 & +wturn3*gshieldx_t3(j,i)
275 & +wturn4*gshieldx_t4(j,i)
276 & +wel_loc*gshieldx_ll(j,i)
284 if (shield_mode.eq.0) then
285 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
286 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
288 & wcorr*fact(3)*gradcorr(j,i)+
289 & wel_loc*fact(2)*gel_loc(j,i)+
290 & wturn3*fact(2)*gcorr3_turn(j,i)+
291 & wturn4*fact(3)*gcorr4_turn(j,i)+
292 & wcorr5*fact(4)*gradcorr5(j,i)+
293 & wcorr6*fact(5)*gradcorr6(j,i)+
294 & wturn6*fact(5)*gcorr6_turn(j,i)+
295 & wsccor*fact(2)*gsccorc(j,i)
296 & +wliptran*gliptranc(j,i)
297 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
299 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
300 & wsccor*fact(1)*gsccorx(j,i)
301 & +wliptran*gliptranx(j,i)
303 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
304 & fact(1)*wscp*gvdwc_scp(j,i)+
305 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
307 & wcorr*fact(3)*gradcorr(j,i)+
308 & wel_loc*fact(2)*gel_loc(j,i)+
309 & wturn3*fact(2)*gcorr3_turn(j,i)+
310 & wturn4*fact(3)*gcorr4_turn(j,i)+
311 & wcorr5*fact(4)*gradcorr5(j,i)+
312 & wcorr6*fact(5)*gradcorr6(j,i)+
313 & wturn6*fact(5)*gcorr6_turn(j,i)+
314 & wsccor*fact(2)*gsccorc(j,i)
315 & +wliptran*gliptranc(j,i)
316 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
317 & fact(1)*wscp*gradx_scp(j,i)+
319 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
320 & wsccor*fact(1)*gsccorx(j,i)
321 & +wliptran*gliptranx(j,i)
329 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
330 & +wcorr5*fact(4)*g_corr5_loc(i)
331 & +wcorr6*fact(5)*g_corr6_loc(i)
332 & +wturn4*fact(3)*gel_loc_turn4(i)
333 & +wturn3*fact(2)*gel_loc_turn3(i)
334 & +wturn6*fact(5)*gel_loc_turn6(i)
335 & +wel_loc*fact(2)*gel_loc_loc(i)
336 c & +wsccor*fact(1)*gsccor_loc(i)
340 if (dyn_ss) call dyn_set_nss
343 C------------------------------------------------------------------------
344 subroutine enerprint(energia,fact)
345 implicit real*8 (a-h,o-z)
347 include 'sizesclu.dat'
348 include 'COMMON.IOUNITS'
349 include 'COMMON.FFIELD'
350 include 'COMMON.SBRIDGE'
351 double precision energia(0:max_ene),fact(6)
353 evdw=energia(1)+fact(6)*energia(21)
355 evdw2=energia(2)+energia(17)
367 eello_turn3=energia(8)
368 eello_turn4=energia(9)
369 eello_turn6=energia(10)
376 edihcnstr=energia(20)
378 ethetacnstr=energia(24)
380 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
382 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
383 & etors_d,wtor_d*fact(2),ehpb,wstrain,
384 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
385 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
386 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
387 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etot
388 10 format (/'Virtual-chain energies:'//
389 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
390 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
391 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
392 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
393 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
394 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
395 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
396 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
397 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
398 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
399 & ' (SS bridges & dist. cnstr.)'/
400 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
401 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
402 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
403 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
404 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
405 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
406 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
407 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
408 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
409 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
410 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
411 & 'ETOT= ',1pE16.6,' (total)')
413 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
414 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
415 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
416 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
417 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
418 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
419 & edihcnstr,ethetacnstr,ebr*nss,etot
420 10 format (/'Virtual-chain energies:'//
421 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
422 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
423 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
424 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
425 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
426 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
427 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
428 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
429 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
430 & ' (SS bridges & dist. cnstr.)'/
431 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
432 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
433 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
434 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
435 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
436 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
437 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
438 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
439 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
440 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
441 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
442 & 'ETOT= ',1pE16.6,' (total)')
446 C-----------------------------------------------------------------------
447 subroutine elj(evdw,evdw_t)
449 C This subroutine calculates the interaction energy of nonbonded side chains
450 C assuming the LJ potential of interaction.
452 implicit real*8 (a-h,o-z)
454 include 'sizesclu.dat'
455 include "DIMENSIONS.COMPAR"
456 parameter (accur=1.0d-10)
459 include 'COMMON.LOCAL'
460 include 'COMMON.CHAIN'
461 include 'COMMON.DERIV'
462 include 'COMMON.INTERACT'
463 include 'COMMON.TORSION'
464 include 'COMMON.SBRIDGE'
465 include 'COMMON.NAMES'
466 include 'COMMON.IOUNITS'
467 include 'COMMON.CONTACTS'
471 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
472 c ROZNICA DODANE Z WHAM
475 c eneps_temp(j,i)=0.0d0
484 if (itypi.eq.ntyp1) cycle
485 itypi1=iabs(itype(i+1))
492 C Calculate SC interaction energy.
495 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
496 cd & 'iend=',iend(i,iint)
497 do j=istart(i,iint),iend(i,iint)
499 if (itypj.eq.ntyp1) cycle
503 C Change 12/1/95 to calculate four-body interactions
504 rij=xj*xj+yj*yj+zj*zj
506 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
507 eps0ij=eps(itypi,itypj)
509 e1=fac*fac*aa(itypi,itypj)
510 e2=fac*bb(itypi,itypj)
512 ij=icant(itypi,itypj)
514 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
515 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
518 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
519 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
520 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
521 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
522 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
523 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
524 if (bb(itypi,itypj).gt.0.0d0) then
531 C Calculate the components of the gradient in DC and X
533 fac=-rrij*(e1+evdwij)
538 gvdwx(k,i)=gvdwx(k,i)-gg(k)
539 gvdwx(k,j)=gvdwx(k,j)+gg(k)
543 gvdwc(l,k)=gvdwc(l,k)+gg(l)
548 C 12/1/95, revised on 5/20/97
550 C Calculate the contact function. The ith column of the array JCONT will
551 C contain the numbers of atoms that make contacts with the atom I (of numbers
552 C greater than I). The arrays FACONT and GACONT will contain the values of
553 C the contact function and its derivative.
555 C Uncomment next line, if the correlation interactions include EVDW explicitly.
556 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
557 C Uncomment next line, if the correlation interactions are contact function only
558 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
560 sigij=sigma(itypi,itypj)
561 r0ij=rs0(itypi,itypj)
563 C Check whether the SC's are not too far to make a contact.
566 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
567 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
569 if (fcont.gt.0.0D0) then
570 C If the SC-SC distance if close to sigma, apply spline.
571 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
572 cAdam & fcont1,fprimcont1)
573 cAdam fcont1=1.0d0-fcont1
574 cAdam if (fcont1.gt.0.0d0) then
575 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
576 cAdam fcont=fcont*fcont1
578 C Uncomment following 4 lines to have the geometric average of the epsilon0's
579 cga eps0ij=1.0d0/dsqrt(eps0ij)
581 cga gg(k)=gg(k)*eps0ij
583 cga eps0ij=-evdwij*eps0ij
584 C Uncomment for AL's type of SC correlation interactions.
586 num_conti=num_conti+1
588 facont(num_conti,i)=fcont*eps0ij
589 fprimcont=eps0ij*fprimcont/rij
591 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
592 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
593 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
594 C Uncomment following 3 lines for Skolnick's type of SC correlation.
595 gacont(1,num_conti,i)=-fprimcont*xj
596 gacont(2,num_conti,i)=-fprimcont*yj
597 gacont(3,num_conti,i)=-fprimcont*zj
598 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
599 cd write (iout,'(2i3,3f10.5)')
600 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
606 num_cont(i)=num_conti
611 gvdwc(j,i)=expon*gvdwc(j,i)
612 gvdwx(j,i)=expon*gvdwx(j,i)
616 C******************************************************************************
620 C To save time, the factor of EXPON has been extracted from ALL components
621 C of GVDWC and GRADX. Remember to multiply them by this factor before further
624 C******************************************************************************
627 C-----------------------------------------------------------------------------
628 subroutine eljk(evdw,evdw_t)
630 C This subroutine calculates the interaction energy of nonbonded side chains
631 C assuming the LJK potential of interaction.
633 implicit real*8 (a-h,o-z)
635 include 'sizesclu.dat'
636 include "DIMENSIONS.COMPAR"
639 include 'COMMON.LOCAL'
640 include 'COMMON.CHAIN'
641 include 'COMMON.DERIV'
642 include 'COMMON.INTERACT'
643 include 'COMMON.IOUNITS'
644 include 'COMMON.NAMES'
649 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
654 if (itypi.eq.ntyp1) cycle
655 itypi1=iabs(itype(i+1))
660 C Calculate SC interaction energy.
663 do j=istart(i,iint),iend(i,iint)
665 if (itypj.eq.ntyp1) cycle
669 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
671 e_augm=augm(itypi,itypj)*fac_augm
674 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
675 fac=r_shift_inv**expon
676 e1=fac*fac*aa(itypi,itypj)
677 e2=fac*bb(itypi,itypj)
679 ij=icant(itypi,itypj)
680 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
681 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
682 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
683 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
684 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
685 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
686 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
687 if (bb(itypi,itypj).gt.0.0d0) then
694 C Calculate the components of the gradient in DC and X
696 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
701 gvdwx(k,i)=gvdwx(k,i)-gg(k)
702 gvdwx(k,j)=gvdwx(k,j)+gg(k)
706 gvdwc(l,k)=gvdwc(l,k)+gg(l)
716 gvdwc(j,i)=expon*gvdwc(j,i)
717 gvdwx(j,i)=expon*gvdwx(j,i)
723 C-----------------------------------------------------------------------------
724 subroutine ebp(evdw,evdw_t)
726 C This subroutine calculates the interaction energy of nonbonded side chains
727 C assuming the Berne-Pechukas potential of interaction.
729 implicit real*8 (a-h,o-z)
731 include 'sizesclu.dat'
732 include "DIMENSIONS.COMPAR"
735 include 'COMMON.LOCAL'
736 include 'COMMON.CHAIN'
737 include 'COMMON.DERIV'
738 include 'COMMON.NAMES'
739 include 'COMMON.INTERACT'
740 include 'COMMON.IOUNITS'
741 include 'COMMON.CALC'
743 c double precision rrsave(maxdim)
749 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
750 c if (icall.eq.0) then
758 if (itypi.eq.ntyp1) cycle
759 itypi1=iabs(itype(i+1))
763 dxi=dc_norm(1,nres+i)
764 dyi=dc_norm(2,nres+i)
765 dzi=dc_norm(3,nres+i)
766 dsci_inv=vbld_inv(i+nres)
768 C Calculate SC interaction energy.
771 do j=istart(i,iint),iend(i,iint)
774 if (itypj.eq.ntyp1) cycle
775 dscj_inv=vbld_inv(j+nres)
776 chi1=chi(itypi,itypj)
777 chi2=chi(itypj,itypi)
784 alf12=0.5D0*(alf1+alf2)
785 C For diagnostics only!!!
798 dxj=dc_norm(1,nres+j)
799 dyj=dc_norm(2,nres+j)
800 dzj=dc_norm(3,nres+j)
801 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
802 cd if (icall.eq.0) then
808 C Calculate the angle-dependent terms of energy & contributions to derivatives.
810 C Calculate whole angle-dependent part of epsilon and contributions
812 fac=(rrij*sigsq)**expon2
813 e1=fac*fac*aa(itypi,itypj)
814 e2=fac*bb(itypi,itypj)
815 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
816 eps2der=evdwij*eps3rt
817 eps3der=evdwij*eps2rt
818 evdwij=evdwij*eps2rt*eps3rt
819 ij=icant(itypi,itypj)
820 aux=eps1*eps2rt**2*eps3rt**2
821 if (bb(itypi,itypj).gt.0.0d0) then
828 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
829 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
830 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
831 cd & restyp(itypi),i,restyp(itypj),j,
832 cd & epsi,sigm,chi1,chi2,chip1,chip2,
833 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
834 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
837 C Calculate gradient components.
838 e1=e1*eps1*eps2rt**2*eps3rt**2
839 fac=-expon*(e1+evdwij)
842 C Calculate radial part of the gradient
846 C Calculate the angular part of the gradient and sum add the contributions
847 C to the appropriate components of the Cartesian gradient.
856 C-----------------------------------------------------------------------------
857 subroutine egb(evdw,evdw_t)
859 C This subroutine calculates the interaction energy of nonbonded side chains
860 C assuming the Gay-Berne potential of interaction.
862 implicit real*8 (a-h,o-z)
864 include 'sizesclu.dat'
865 include "DIMENSIONS.COMPAR"
868 include 'COMMON.LOCAL'
869 include 'COMMON.CHAIN'
870 include 'COMMON.DERIV'
871 include 'COMMON.NAMES'
872 include 'COMMON.INTERACT'
873 include 'COMMON.IOUNITS'
874 include 'COMMON.CALC'
875 include 'COMMON.SBRIDGE'
880 integer xshift,yshift,zshift
881 logical energy_dec /.false./
882 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
886 c if (icall.gt.0) lprn=.true.
890 if (itypi.eq.ntyp1) cycle
891 itypi1=iabs(itype(i+1))
896 if (xi.lt.0) xi=xi+boxxsize
898 if (yi.lt.0) yi=yi+boxysize
900 if (zi.lt.0) zi=zi+boxzsize
901 dxi=dc_norm(1,nres+i)
902 dyi=dc_norm(2,nres+i)
903 dzi=dc_norm(3,nres+i)
904 dsci_inv=vbld_inv(i+nres)
906 C Calculate SC interaction energy.
909 do j=istart(i,iint),iend(i,iint)
910 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
912 c write(iout,*) "PRZED ZWYKLE", evdwij
913 call dyn_ssbond_ene(i,j,evdwij)
914 c write(iout,*) "PO ZWYKLE", evdwij
917 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
918 & 'evdw',i,j,evdwij,' ss'
919 C triple bond artifac removal
920 do k=j+1,iend(i,iint)
921 C search over all next residues
922 if (dyn_ss_mask(k)) then
923 C check if they are cysteins
924 C write(iout,*) 'k=',k
926 c write(iout,*) "PRZED TRI", evdwij
927 evdwij_przed_tri=evdwij
928 call triple_ssbond_ene(i,j,k,evdwij)
929 c if(evdwij_przed_tri.ne.evdwij) then
930 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
933 c write(iout,*) "PO TRI", evdwij
934 C call the energy function that removes the artifical triple disulfide
935 C bond the soubroutine is located in ssMD.F
937 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
938 & 'evdw',i,j,evdwij,'tss'
944 if (itypj.eq.ntyp1) cycle
945 dscj_inv=vbld_inv(j+nres)
946 sig0ij=sigma(itypi,itypj)
947 chi1=chi(itypi,itypj)
948 chi2=chi(itypj,itypi)
955 alf12=0.5D0*(alf1+alf2)
956 C For diagnostics only!!!
970 if (xj.lt.0) xj=xj+boxxsize
972 if (yj.lt.0) yj=yj+boxysize
974 if (zj.lt.0) zj=zj+boxzsize
975 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
983 xj=xj_safe+xshift*boxxsize
984 yj=yj_safe+yshift*boxysize
985 zj=zj_safe+zshift*boxzsize
986 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
987 if(dist_temp.lt.dist_init) then
997 if (subchap.eq.1) then
1006 dxj=dc_norm(1,nres+j)
1007 dyj=dc_norm(2,nres+j)
1008 dzj=dc_norm(3,nres+j)
1009 c write (iout,*) i,j,xj,yj,zj
1010 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1012 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1013 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1014 if (sss.le.0.0d0) cycle
1015 C Calculate angle-dependent terms of energy and contributions to their
1019 sig=sig0ij*dsqrt(sigsq)
1020 rij_shift=1.0D0/rij-sig+sig0ij
1021 C I hate to put IF's in the loops, but here don't have another choice!!!!
1022 if (rij_shift.le.0.0D0) then
1027 c---------------------------------------------------------------
1028 rij_shift=1.0D0/rij_shift
1029 fac=rij_shift**expon
1030 e1=fac*fac*aa(itypi,itypj)
1031 e2=fac*bb(itypi,itypj)
1032 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1033 eps2der=evdwij*eps3rt
1034 eps3der=evdwij*eps2rt
1035 evdwij=evdwij*eps2rt*eps3rt
1036 if (bb(itypi,itypj).gt.0) then
1037 evdw=evdw+evdwij*sss
1039 evdw_t=evdw_t+evdwij*sss
1041 ij=icant(itypi,itypj)
1042 aux=eps1*eps2rt**2*eps3rt**2
1043 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1044 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1045 c & aux*e2/eps(itypi,itypj)
1047 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1048 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1050 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1051 & restyp(itypi),i,restyp(itypj),j,
1052 & epsi,sigm,chi1,chi2,chip1,chip2,
1053 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1054 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1056 write (iout,*) "pratial sum", evdw,evdw_t
1060 C Calculate gradient components.
1061 e1=e1*eps1*eps2rt**2*eps3rt**2
1062 fac=-expon*(e1+evdwij)*rij_shift
1065 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1066 C Calculate the radial part of the gradient
1070 C Calculate angular part of the gradient.
1079 C-----------------------------------------------------------------------------
1080 subroutine egbv(evdw,evdw_t)
1082 C This subroutine calculates the interaction energy of nonbonded side chains
1083 C assuming the Gay-Berne-Vorobjev potential of interaction.
1085 implicit real*8 (a-h,o-z)
1086 include 'DIMENSIONS'
1087 include 'sizesclu.dat'
1088 include "DIMENSIONS.COMPAR"
1089 include 'COMMON.GEO'
1090 include 'COMMON.VAR'
1091 include 'COMMON.LOCAL'
1092 include 'COMMON.CHAIN'
1093 include 'COMMON.DERIV'
1094 include 'COMMON.NAMES'
1095 include 'COMMON.INTERACT'
1096 include 'COMMON.IOUNITS'
1097 include 'COMMON.CALC'
1098 common /srutu/ icall
1104 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1107 c if (icall.gt.0) lprn=.true.
1109 do i=iatsc_s,iatsc_e
1110 itypi=iabs(itype(i))
1111 if (itypi.eq.ntyp1) cycle
1112 itypi1=iabs(itype(i+1))
1116 dxi=dc_norm(1,nres+i)
1117 dyi=dc_norm(2,nres+i)
1118 dzi=dc_norm(3,nres+i)
1119 dsci_inv=vbld_inv(i+nres)
1121 C Calculate SC interaction energy.
1123 do iint=1,nint_gr(i)
1124 do j=istart(i,iint),iend(i,iint)
1126 itypj=iabs(itype(j))
1127 if (itypj.eq.ntyp1) cycle
1128 dscj_inv=vbld_inv(j+nres)
1129 sig0ij=sigma(itypi,itypj)
1130 r0ij=r0(itypi,itypj)
1131 chi1=chi(itypi,itypj)
1132 chi2=chi(itypj,itypi)
1139 alf12=0.5D0*(alf1+alf2)
1140 C For diagnostics only!!!
1153 dxj=dc_norm(1,nres+j)
1154 dyj=dc_norm(2,nres+j)
1155 dzj=dc_norm(3,nres+j)
1156 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1158 C Calculate angle-dependent terms of energy and contributions to their
1162 sig=sig0ij*dsqrt(sigsq)
1163 rij_shift=1.0D0/rij-sig+r0ij
1164 C I hate to put IF's in the loops, but here don't have another choice!!!!
1165 if (rij_shift.le.0.0D0) then
1170 c---------------------------------------------------------------
1171 rij_shift=1.0D0/rij_shift
1172 fac=rij_shift**expon
1173 e1=fac*fac*aa(itypi,itypj)
1174 e2=fac*bb(itypi,itypj)
1175 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1176 eps2der=evdwij*eps3rt
1177 eps3der=evdwij*eps2rt
1178 fac_augm=rrij**expon
1179 e_augm=augm(itypi,itypj)*fac_augm
1180 evdwij=evdwij*eps2rt*eps3rt
1181 if (bb(itypi,itypj).gt.0.0d0) then
1182 evdw=evdw+evdwij+e_augm
1184 evdw_t=evdw_t+evdwij+e_augm
1186 ij=icant(itypi,itypj)
1187 aux=eps1*eps2rt**2*eps3rt**2
1189 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1190 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1191 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1192 c & restyp(itypi),i,restyp(itypj),j,
1193 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1194 c & chi1,chi2,chip1,chip2,
1195 c & eps1,eps2rt**2,eps3rt**2,
1196 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1200 C Calculate gradient components.
1201 e1=e1*eps1*eps2rt**2*eps3rt**2
1202 fac=-expon*(e1+evdwij)*rij_shift
1204 fac=rij*fac-2*expon*rrij*e_augm
1205 C Calculate the radial part of the gradient
1209 C Calculate angular part of the gradient.
1217 C-----------------------------------------------------------------------------
1218 subroutine sc_angular
1219 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1220 C om12. Called by ebp, egb, and egbv.
1222 include 'COMMON.CALC'
1226 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1227 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1228 om12=dxi*dxj+dyi*dyj+dzi*dzj
1230 C Calculate eps1(om12) and its derivative in om12
1231 faceps1=1.0D0-om12*chiom12
1232 faceps1_inv=1.0D0/faceps1
1233 eps1=dsqrt(faceps1_inv)
1234 C Following variable is eps1*deps1/dom12
1235 eps1_om12=faceps1_inv*chiom12
1236 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1241 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1242 sigsq=1.0D0-facsig*faceps1_inv
1243 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1244 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1245 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1246 C Calculate eps2 and its derivatives in om1, om2, and om12.
1249 chipom12=chip12*om12
1250 facp=1.0D0-om12*chipom12
1252 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1253 C Following variable is the square root of eps2
1254 eps2rt=1.0D0-facp1*facp_inv
1255 C Following three variables are the derivatives of the square root of eps
1256 C in om1, om2, and om12.
1257 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1258 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1259 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1260 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1261 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1262 C Calculate whole angle-dependent part of epsilon and contributions
1263 C to its derivatives
1266 C----------------------------------------------------------------------------
1268 implicit real*8 (a-h,o-z)
1269 include 'DIMENSIONS'
1270 include 'sizesclu.dat'
1271 include 'COMMON.CHAIN'
1272 include 'COMMON.DERIV'
1273 include 'COMMON.CALC'
1274 double precision dcosom1(3),dcosom2(3)
1275 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1276 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1277 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1278 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1280 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1281 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1284 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1287 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1288 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1289 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1290 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1291 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1292 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1295 C Calculate the components of the gradient in DC and X
1299 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1304 c------------------------------------------------------------------------------
1305 subroutine vec_and_deriv
1306 implicit real*8 (a-h,o-z)
1307 include 'DIMENSIONS'
1308 include 'sizesclu.dat'
1309 include 'COMMON.IOUNITS'
1310 include 'COMMON.GEO'
1311 include 'COMMON.VAR'
1312 include 'COMMON.LOCAL'
1313 include 'COMMON.CHAIN'
1314 include 'COMMON.VECTORS'
1315 include 'COMMON.DERIV'
1316 include 'COMMON.INTERACT'
1317 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1318 C Compute the local reference systems. For reference system (i), the
1319 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1320 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1322 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1323 if (i.eq.nres-1) then
1324 C Case of the last full residue
1325 C Compute the Z-axis
1326 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1327 costh=dcos(pi-theta(nres))
1328 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1333 C Compute the derivatives of uz
1335 uzder(2,1,1)=-dc_norm(3,i-1)
1336 uzder(3,1,1)= dc_norm(2,i-1)
1337 uzder(1,2,1)= dc_norm(3,i-1)
1339 uzder(3,2,1)=-dc_norm(1,i-1)
1340 uzder(1,3,1)=-dc_norm(2,i-1)
1341 uzder(2,3,1)= dc_norm(1,i-1)
1344 uzder(2,1,2)= dc_norm(3,i)
1345 uzder(3,1,2)=-dc_norm(2,i)
1346 uzder(1,2,2)=-dc_norm(3,i)
1348 uzder(3,2,2)= dc_norm(1,i)
1349 uzder(1,3,2)= dc_norm(2,i)
1350 uzder(2,3,2)=-dc_norm(1,i)
1353 C Compute the Y-axis
1356 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1359 C Compute the derivatives of uy
1362 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1363 & -dc_norm(k,i)*dc_norm(j,i-1)
1364 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1366 uyder(j,j,1)=uyder(j,j,1)-costh
1367 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1372 uygrad(l,k,j,i)=uyder(l,k,j)
1373 uzgrad(l,k,j,i)=uzder(l,k,j)
1377 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1378 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1379 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1380 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1384 C Compute the Z-axis
1385 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1386 costh=dcos(pi-theta(i+2))
1387 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1392 C Compute the derivatives of uz
1394 uzder(2,1,1)=-dc_norm(3,i+1)
1395 uzder(3,1,1)= dc_norm(2,i+1)
1396 uzder(1,2,1)= dc_norm(3,i+1)
1398 uzder(3,2,1)=-dc_norm(1,i+1)
1399 uzder(1,3,1)=-dc_norm(2,i+1)
1400 uzder(2,3,1)= dc_norm(1,i+1)
1403 uzder(2,1,2)= dc_norm(3,i)
1404 uzder(3,1,2)=-dc_norm(2,i)
1405 uzder(1,2,2)=-dc_norm(3,i)
1407 uzder(3,2,2)= dc_norm(1,i)
1408 uzder(1,3,2)= dc_norm(2,i)
1409 uzder(2,3,2)=-dc_norm(1,i)
1412 C Compute the Y-axis
1415 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1418 C Compute the derivatives of uy
1421 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1422 & -dc_norm(k,i)*dc_norm(j,i+1)
1423 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1425 uyder(j,j,1)=uyder(j,j,1)-costh
1426 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1431 uygrad(l,k,j,i)=uyder(l,k,j)
1432 uzgrad(l,k,j,i)=uzder(l,k,j)
1436 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1437 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1438 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1439 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1445 vbld_inv_temp(1)=vbld_inv(i+1)
1446 if (i.lt.nres-1) then
1447 vbld_inv_temp(2)=vbld_inv(i+2)
1449 vbld_inv_temp(2)=vbld_inv(i)
1454 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1455 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1463 C-----------------------------------------------------------------------------
1464 subroutine vec_and_deriv_test
1465 implicit real*8 (a-h,o-z)
1466 include 'DIMENSIONS'
1467 include 'sizesclu.dat'
1468 include 'COMMON.IOUNITS'
1469 include 'COMMON.GEO'
1470 include 'COMMON.VAR'
1471 include 'COMMON.LOCAL'
1472 include 'COMMON.CHAIN'
1473 include 'COMMON.VECTORS'
1474 dimension uyder(3,3,2),uzder(3,3,2)
1475 C Compute the local reference systems. For reference system (i), the
1476 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1477 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1479 if (i.eq.nres-1) then
1480 C Case of the last full residue
1481 C Compute the Z-axis
1482 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1483 costh=dcos(pi-theta(nres))
1484 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1485 c write (iout,*) 'fac',fac,
1486 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1487 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1491 C Compute the derivatives of uz
1493 uzder(2,1,1)=-dc_norm(3,i-1)
1494 uzder(3,1,1)= dc_norm(2,i-1)
1495 uzder(1,2,1)= dc_norm(3,i-1)
1497 uzder(3,2,1)=-dc_norm(1,i-1)
1498 uzder(1,3,1)=-dc_norm(2,i-1)
1499 uzder(2,3,1)= dc_norm(1,i-1)
1502 uzder(2,1,2)= dc_norm(3,i)
1503 uzder(3,1,2)=-dc_norm(2,i)
1504 uzder(1,2,2)=-dc_norm(3,i)
1506 uzder(3,2,2)= dc_norm(1,i)
1507 uzder(1,3,2)= dc_norm(2,i)
1508 uzder(2,3,2)=-dc_norm(1,i)
1510 C Compute the Y-axis
1512 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1515 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1516 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1517 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1519 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1522 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1523 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1526 c write (iout,*) 'facy',facy,
1527 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1528 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1530 uy(k,i)=facy*uy(k,i)
1532 C Compute the derivatives of uy
1535 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1536 & -dc_norm(k,i)*dc_norm(j,i-1)
1537 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1539 c uyder(j,j,1)=uyder(j,j,1)-costh
1540 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1541 uyder(j,j,1)=uyder(j,j,1)
1542 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1543 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1549 uygrad(l,k,j,i)=uyder(l,k,j)
1550 uzgrad(l,k,j,i)=uzder(l,k,j)
1554 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1555 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1556 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1557 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1560 C Compute the Z-axis
1561 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1562 costh=dcos(pi-theta(i+2))
1563 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1564 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1568 C Compute the derivatives of uz
1570 uzder(2,1,1)=-dc_norm(3,i+1)
1571 uzder(3,1,1)= dc_norm(2,i+1)
1572 uzder(1,2,1)= dc_norm(3,i+1)
1574 uzder(3,2,1)=-dc_norm(1,i+1)
1575 uzder(1,3,1)=-dc_norm(2,i+1)
1576 uzder(2,3,1)= dc_norm(1,i+1)
1579 uzder(2,1,2)= dc_norm(3,i)
1580 uzder(3,1,2)=-dc_norm(2,i)
1581 uzder(1,2,2)=-dc_norm(3,i)
1583 uzder(3,2,2)= dc_norm(1,i)
1584 uzder(1,3,2)= dc_norm(2,i)
1585 uzder(2,3,2)=-dc_norm(1,i)
1587 C Compute the Y-axis
1589 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1590 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1591 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1593 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1596 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1597 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1600 c write (iout,*) 'facy',facy,
1601 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1602 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1604 uy(k,i)=facy*uy(k,i)
1606 C Compute the derivatives of uy
1609 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1610 & -dc_norm(k,i)*dc_norm(j,i+1)
1611 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1613 c uyder(j,j,1)=uyder(j,j,1)-costh
1614 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1615 uyder(j,j,1)=uyder(j,j,1)
1616 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1617 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1623 uygrad(l,k,j,i)=uyder(l,k,j)
1624 uzgrad(l,k,j,i)=uzder(l,k,j)
1628 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1629 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1630 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1631 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1638 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1639 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1646 C-----------------------------------------------------------------------------
1647 subroutine check_vecgrad
1648 implicit real*8 (a-h,o-z)
1649 include 'DIMENSIONS'
1650 include 'sizesclu.dat'
1651 include 'COMMON.IOUNITS'
1652 include 'COMMON.GEO'
1653 include 'COMMON.VAR'
1654 include 'COMMON.LOCAL'
1655 include 'COMMON.CHAIN'
1656 include 'COMMON.VECTORS'
1657 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1658 dimension uyt(3,maxres),uzt(3,maxres)
1659 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1660 double precision delta /1.0d-7/
1663 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1664 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1665 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1666 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1667 cd & (dc_norm(if90,i),if90=1,3)
1668 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1669 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1670 cd write(iout,'(a)')
1676 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1677 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1690 cd write (iout,*) 'i=',i
1692 erij(k)=dc_norm(k,i)
1696 dc_norm(k,i)=erij(k)
1698 dc_norm(j,i)=dc_norm(j,i)+delta
1699 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1701 c dc_norm(k,i)=dc_norm(k,i)/fac
1703 c write (iout,*) (dc_norm(k,i),k=1,3)
1704 c write (iout,*) (erij(k),k=1,3)
1707 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1708 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1709 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1710 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1712 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1713 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1714 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1717 dc_norm(k,i)=erij(k)
1720 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1721 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1722 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1723 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1724 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1725 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1726 cd write (iout,'(a)')
1731 C--------------------------------------------------------------------------
1732 subroutine set_matrices
1733 implicit real*8 (a-h,o-z)
1734 include 'DIMENSIONS'
1735 include 'sizesclu.dat'
1736 include 'COMMON.IOUNITS'
1737 include 'COMMON.GEO'
1738 include 'COMMON.VAR'
1739 include 'COMMON.LOCAL'
1740 include 'COMMON.CHAIN'
1741 include 'COMMON.DERIV'
1742 include 'COMMON.INTERACT'
1743 include 'COMMON.CONTACTS'
1744 include 'COMMON.TORSION'
1745 include 'COMMON.VECTORS'
1746 include 'COMMON.FFIELD'
1747 double precision auxvec(2),auxmat(2,2)
1749 C Compute the virtual-bond-torsional-angle dependent quantities needed
1750 C to calculate the el-loc multibody terms of various order.
1753 if (i .lt. nres+1) then
1790 if (i .gt. 3 .and. i .lt. nres+1) then
1791 obrot_der(1,i-2)=-sin1
1792 obrot_der(2,i-2)= cos1
1793 Ugder(1,1,i-2)= sin1
1794 Ugder(1,2,i-2)=-cos1
1795 Ugder(2,1,i-2)=-cos1
1796 Ugder(2,2,i-2)=-sin1
1799 obrot2_der(1,i-2)=-dwasin2
1800 obrot2_der(2,i-2)= dwacos2
1801 Ug2der(1,1,i-2)= dwasin2
1802 Ug2der(1,2,i-2)=-dwacos2
1803 Ug2der(2,1,i-2)=-dwacos2
1804 Ug2der(2,2,i-2)=-dwasin2
1806 obrot_der(1,i-2)=0.0d0
1807 obrot_der(2,i-2)=0.0d0
1808 Ugder(1,1,i-2)=0.0d0
1809 Ugder(1,2,i-2)=0.0d0
1810 Ugder(2,1,i-2)=0.0d0
1811 Ugder(2,2,i-2)=0.0d0
1812 obrot2_der(1,i-2)=0.0d0
1813 obrot2_der(2,i-2)=0.0d0
1814 Ug2der(1,1,i-2)=0.0d0
1815 Ug2der(1,2,i-2)=0.0d0
1816 Ug2der(2,1,i-2)=0.0d0
1817 Ug2der(2,2,i-2)=0.0d0
1819 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1820 if (itype(i-2).le.ntyp) then
1821 iti = itortyp(itype(i-2))
1828 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1829 if (itype(i-1).le.ntyp) then
1830 iti1 = itortyp(itype(i-1))
1837 cd write (iout,*) '*******i',i,' iti1',iti
1838 cd write (iout,*) 'b1',b1(:,iti)
1839 cd write (iout,*) 'b2',b2(:,iti)
1840 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1841 c print *,"itilde1 i iti iti1",i,iti,iti1
1842 if (i .gt. iatel_s+2) then
1843 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1844 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1845 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1846 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1847 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1848 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1849 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1859 DtUg2(l,k,i-2)=0.0d0
1863 c print *,"itilde2 i iti iti1",i,iti,iti1
1864 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1865 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1866 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1867 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1868 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1869 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1870 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1871 c print *,"itilde3 i iti iti1",i,iti,iti1
1873 muder(k,i-2)=Ub2der(k,i-2)
1875 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1876 if (itype(i-1).le.ntyp) then
1877 iti1 = itortyp(itype(i-1))
1885 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1887 C Vectors and matrices dependent on a single virtual-bond dihedral.
1888 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1889 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1890 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1891 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1892 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1893 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1894 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1895 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1896 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1897 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1898 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1900 C Matrices dependent on two consecutive virtual-bond dihedrals.
1901 C The order of matrices is from left to right.
1903 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1904 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1905 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1906 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1907 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1908 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1909 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1910 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1913 cd iti = itortyp(itype(i))
1916 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1917 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1922 C--------------------------------------------------------------------------
1923 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1925 C This subroutine calculates the average interaction energy and its gradient
1926 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1927 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1928 C The potential depends both on the distance of peptide-group centers and on
1929 C the orientation of the CA-CA virtual bonds.
1931 implicit real*8 (a-h,o-z)
1932 include 'DIMENSIONS'
1933 include 'sizesclu.dat'
1934 include 'COMMON.CONTROL'
1935 include 'COMMON.IOUNITS'
1936 include 'COMMON.GEO'
1937 include 'COMMON.VAR'
1938 include 'COMMON.LOCAL'
1939 include 'COMMON.CHAIN'
1940 include 'COMMON.DERIV'
1941 include 'COMMON.INTERACT'
1942 include 'COMMON.CONTACTS'
1943 include 'COMMON.TORSION'
1944 include 'COMMON.VECTORS'
1945 include 'COMMON.FFIELD'
1946 include 'COMMON.SHIELD'
1948 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1949 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1950 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1951 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1952 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1953 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1954 double precision scal_el /0.5d0/
1956 C 13-go grudnia roku pamietnego...
1957 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1958 & 0.0d0,1.0d0,0.0d0,
1959 & 0.0d0,0.0d0,1.0d0/
1960 cd write(iout,*) 'In EELEC'
1962 cd write(iout,*) 'Type',i
1963 cd write(iout,*) 'B1',B1(:,i)
1964 cd write(iout,*) 'B2',B2(:,i)
1965 cd write(iout,*) 'CC',CC(:,:,i)
1966 cd write(iout,*) 'DD',DD(:,:,i)
1967 cd write(iout,*) 'EE',EE(:,:,i)
1969 cd call check_vecgrad
1971 if (icheckgrad.eq.1) then
1973 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1975 dc_norm(k,i)=dc(k,i)*fac
1977 c write (iout,*) 'i',i,' fac',fac
1980 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1981 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1982 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1983 cd if (wel_loc.gt.0.0d0) then
1984 if (icheckgrad.eq.1) then
1985 call vec_and_deriv_test
1992 cd write (iout,*) 'i=',i
1994 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1997 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1998 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2011 cd print '(a)','Enter EELEC'
2012 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2014 gel_loc_loc(i)=0.0d0
2017 do i=iatel_s,iatel_e
2019 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2020 C & .or. itype(i+2).eq.ntyp1) cycle
2022 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2023 C & .or. itype(i+2).eq.ntyp1
2024 C & .or. itype(i-1).eq.ntyp1
2027 if (itel(i).eq.0) goto 1215
2031 dx_normi=dc_norm(1,i)
2032 dy_normi=dc_norm(2,i)
2033 dz_normi=dc_norm(3,i)
2034 xmedi=c(1,i)+0.5d0*dxi
2035 ymedi=c(2,i)+0.5d0*dyi
2036 zmedi=c(3,i)+0.5d0*dzi
2037 xmedi=mod(xmedi,boxxsize)
2038 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2039 ymedi=mod(ymedi,boxysize)
2040 if (ymedi.lt.0) ymedi=ymedi+boxysize
2041 zmedi=mod(zmedi,boxzsize)
2042 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2044 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2045 do j=ielstart(i),ielend(i)
2047 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2048 C & .or.itype(j+2).eq.ntyp1
2051 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2052 C & .or.itype(j+2).eq.ntyp1
2053 C & .or.itype(j-1).eq.ntyp1
2056 if (itel(j).eq.0) goto 1216
2060 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2061 aaa=app(iteli,itelj)
2062 bbb=bpp(iteli,itelj)
2063 C Diagnostics only!!!
2069 ael6i=ael6(iteli,itelj)
2070 ael3i=ael3(iteli,itelj)
2074 dx_normj=dc_norm(1,j)
2075 dy_normj=dc_norm(2,j)
2076 dz_normj=dc_norm(3,j)
2081 if (xj.lt.0) xj=xj+boxxsize
2083 if (yj.lt.0) yj=yj+boxysize
2085 if (zj.lt.0) zj=zj+boxzsize
2086 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2094 xj=xj_safe+xshift*boxxsize
2095 yj=yj_safe+yshift*boxysize
2096 zj=zj_safe+zshift*boxzsize
2097 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2098 if(dist_temp.lt.dist_init) then
2108 if (isubchap.eq.1) then
2118 rij=xj*xj+yj*yj+zj*zj
2119 sss=sscale(sqrt(rij))
2120 sssgrad=sscagrad(sqrt(rij))
2126 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2127 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2128 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2129 fac=cosa-3.0D0*cosb*cosg
2131 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2132 if (j.eq.i+2) ev1=scal_el*ev1
2137 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2140 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2141 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2142 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2143 if (shield_mode.gt.0) then
2148 write(iout,*) "ees_compon",i,j,el1,el2,
2149 & fac_shield(i),fac_shield(j)
2152 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2153 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2163 evdw1=evdw1+evdwij*sss
2164 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2165 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2166 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2167 cd & xmedi,ymedi,zmedi,xj,yj,zj
2169 C Calculate contributions to the Cartesian gradient.
2172 facvdw=-6*rrmij*(ev1+evdwij)*sss
2173 facel=-3*rrmij*(el1+eesij)
2180 * Radial derivatives. First process both termini of the fragment (i,j)
2186 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2187 & (shield_mode.gt.0)) then
2189 do ilist=1,ishield_list(i)
2190 iresshield=shield_list(ilist,i)
2192 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2194 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2196 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2197 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2198 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2199 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2200 C if (iresshield.gt.i) then
2201 C do ishi=i+1,iresshield-1
2202 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2203 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2207 C do ishi=iresshield,i
2208 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2209 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2217 do ilist=1,ishield_list(j)
2218 iresshield=shield_list(ilist,j)
2220 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2222 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2224 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2225 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2230 gshieldc(k,i)=gshieldc(k,i)+
2231 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2232 gshieldc(k,j)=gshieldc(k,j)+
2233 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2234 gshieldc(k,i-1)=gshieldc(k,i-1)+
2235 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2236 gshieldc(k,j-1)=gshieldc(k,j-1)+
2237 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2244 gelc(k,i)=gelc(k,i)+ghalf
2245 gelc(k,j)=gelc(k,j)+ghalf
2248 * Loop over residues i+1 thru j-1.
2252 gelc(l,k)=gelc(l,k)+ggg(l)
2258 if (sss.gt.0.0) then
2259 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2260 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2261 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2269 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2270 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2273 * Loop over residues i+1 thru j-1.
2277 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2281 facvdw=(ev1+evdwij)*sss
2284 fac=-3*rrmij*(facvdw+facvdw+facel)
2290 * Radial derivatives. First process both termini of the fragment (i,j)
2297 gelc(k,i)=gelc(k,i)+ghalf
2298 gelc(k,j)=gelc(k,j)+ghalf
2301 * Loop over residues i+1 thru j-1.
2305 gelc(l,k)=gelc(l,k)+ggg(l)
2312 ecosa=2.0D0*fac3*fac1+fac4
2315 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2316 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2318 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2319 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2321 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2322 cd & (dcosg(k),k=1,3)
2324 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2325 & *fac_shield(i)**2*fac_shield(j)**2
2329 gelc(k,i)=gelc(k,i)+ghalf
2330 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2331 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2332 & *fac_shield(i)**2*fac_shield(j)**2
2334 gelc(k,j)=gelc(k,j)+ghalf
2335 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2336 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2337 & *fac_shield(i)**2*fac_shield(j)**2
2341 gelc(l,k)=gelc(l,k)+ggg(l)
2346 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2347 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2348 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2350 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2351 C energy of a peptide unit is assumed in the form of a second-order
2352 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2353 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2354 C are computed for EVERY pair of non-contiguous peptide groups.
2356 if (j.lt.nres-1) then
2367 muij(kkk)=mu(k,i)*mu(l,j)
2370 cd write (iout,*) 'EELEC: i',i,' j',j
2371 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2372 cd write(iout,*) 'muij',muij
2373 ury=scalar(uy(1,i),erij)
2374 urz=scalar(uz(1,i),erij)
2375 vry=scalar(uy(1,j),erij)
2376 vrz=scalar(uz(1,j),erij)
2377 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2378 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2379 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2380 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2381 C For diagnostics only
2386 fac=dsqrt(-ael6i)*r3ij
2387 cd write (2,*) 'fac=',fac
2388 C For diagnostics only
2394 cd write (iout,'(4i5,4f10.5)')
2395 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2396 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2397 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2398 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2399 cd write (iout,'(4f10.5)')
2400 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2401 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2402 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2403 cd write (iout,'(2i3,9f10.5/)') i,j,
2404 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2406 C Derivatives of the elements of A in virtual-bond vectors
2407 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2414 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2415 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2416 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2417 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2418 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2419 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2420 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2421 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2422 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2423 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2424 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2425 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2435 C Compute radial contributions to the gradient
2457 C Add the contributions coming from er
2460 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2461 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2462 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2463 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2466 C Derivatives in DC(i)
2467 ghalf1=0.5d0*agg(k,1)
2468 ghalf2=0.5d0*agg(k,2)
2469 ghalf3=0.5d0*agg(k,3)
2470 ghalf4=0.5d0*agg(k,4)
2471 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2472 & -3.0d0*uryg(k,2)*vry)+ghalf1
2473 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2474 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2475 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2476 & -3.0d0*urzg(k,2)*vry)+ghalf3
2477 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2478 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2479 C Derivatives in DC(i+1)
2480 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2481 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2482 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2483 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2484 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2485 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2486 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2487 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2488 C Derivatives in DC(j)
2489 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2490 & -3.0d0*vryg(k,2)*ury)+ghalf1
2491 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2492 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2493 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2494 & -3.0d0*vryg(k,2)*urz)+ghalf3
2495 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2496 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2497 C Derivatives in DC(j+1) or DC(nres-1)
2498 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2499 & -3.0d0*vryg(k,3)*ury)
2500 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2501 & -3.0d0*vrzg(k,3)*ury)
2502 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2503 & -3.0d0*vryg(k,3)*urz)
2504 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2505 & -3.0d0*vrzg(k,3)*urz)
2510 C Derivatives in DC(i+1)
2511 cd aggi1(k,1)=agg(k,1)
2512 cd aggi1(k,2)=agg(k,2)
2513 cd aggi1(k,3)=agg(k,3)
2514 cd aggi1(k,4)=agg(k,4)
2515 C Derivatives in DC(j)
2520 C Derivatives in DC(j+1)
2525 if (j.eq.nres-1 .and. i.lt.j-2) then
2527 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2528 cd aggj1(k,l)=agg(k,l)
2534 C Check the loc-el terms by numerical integration
2544 aggi(k,l)=-aggi(k,l)
2545 aggi1(k,l)=-aggi1(k,l)
2546 aggj(k,l)=-aggj(k,l)
2547 aggj1(k,l)=-aggj1(k,l)
2550 if (j.lt.nres-1) then
2556 aggi(k,l)=-aggi(k,l)
2557 aggi1(k,l)=-aggi1(k,l)
2558 aggj(k,l)=-aggj(k,l)
2559 aggj1(k,l)=-aggj1(k,l)
2570 aggi(k,l)=-aggi(k,l)
2571 aggi1(k,l)=-aggi1(k,l)
2572 aggj(k,l)=-aggj(k,l)
2573 aggj1(k,l)=-aggj1(k,l)
2579 IF (wel_loc.gt.0.0d0) THEN
2580 C Contribution to the local-electrostatic energy coming from the i-j pair
2581 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2583 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2584 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2585 if (shield_mode.eq.0) then
2592 eel_loc_ij=eel_loc_ij
2593 & *fac_shield(i)*fac_shield(j)
2594 eel_loc=eel_loc+eel_loc_ij
2595 C Partial derivatives in virtual-bond dihedral angles gamma
2597 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2598 & (shield_mode.gt.0)) then
2601 do ilist=1,ishield_list(i)
2602 iresshield=shield_list(ilist,i)
2604 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2607 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2609 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2610 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2614 do ilist=1,ishield_list(j)
2615 iresshield=shield_list(ilist,j)
2617 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2620 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2622 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2623 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2629 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2630 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2631 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2632 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2633 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2634 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2635 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2636 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2640 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2641 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2642 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2643 & *fac_shield(i)*fac_shield(j)
2644 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2645 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2646 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2647 & *fac_shield(i)*fac_shield(j)
2649 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2650 cd write(iout,*) 'agg ',agg
2651 cd write(iout,*) 'aggi ',aggi
2652 cd write(iout,*) 'aggi1',aggi1
2653 cd write(iout,*) 'aggj ',aggj
2654 cd write(iout,*) 'aggj1',aggj1
2656 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2658 ggg(l)=agg(l,1)*muij(1)+
2659 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2660 & *fac_shield(i)*fac_shield(j)
2665 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2668 C Remaining derivatives of eello
2670 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2671 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2672 & *fac_shield(i)*fac_shield(j)
2674 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2675 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2676 & *fac_shield(i)*fac_shield(j)
2678 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2679 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2680 & *fac_shield(i)*fac_shield(j)
2682 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2683 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2684 & *fac_shield(i)*fac_shield(j)
2689 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2690 C Contributions from turns
2695 call eturn34(i,j,eello_turn3,eello_turn4)
2697 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2698 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2700 C Calculate the contact function. The ith column of the array JCONT will
2701 C contain the numbers of atoms that make contacts with the atom I (of numbers
2702 C greater than I). The arrays FACONT and GACONT will contain the values of
2703 C the contact function and its derivative.
2704 c r0ij=1.02D0*rpp(iteli,itelj)
2705 c r0ij=1.11D0*rpp(iteli,itelj)
2706 r0ij=2.20D0*rpp(iteli,itelj)
2707 c r0ij=1.55D0*rpp(iteli,itelj)
2708 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2709 if (fcont.gt.0.0D0) then
2710 num_conti=num_conti+1
2711 if (num_conti.gt.maxconts) then
2712 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2713 & ' will skip next contacts for this conf.'
2715 jcont_hb(num_conti,i)=j
2716 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2717 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2718 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2720 d_cont(num_conti,i)=rij
2721 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2722 C --- Electrostatic-interaction matrix ---
2723 a_chuj(1,1,num_conti,i)=a22
2724 a_chuj(1,2,num_conti,i)=a23
2725 a_chuj(2,1,num_conti,i)=a32
2726 a_chuj(2,2,num_conti,i)=a33
2727 C --- Gradient of rij
2729 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2732 c a_chuj(1,1,num_conti,i)=-0.61d0
2733 c a_chuj(1,2,num_conti,i)= 0.4d0
2734 c a_chuj(2,1,num_conti,i)= 0.65d0
2735 c a_chuj(2,2,num_conti,i)= 0.50d0
2736 c else if (i.eq.2) then
2737 c a_chuj(1,1,num_conti,i)= 0.0d0
2738 c a_chuj(1,2,num_conti,i)= 0.0d0
2739 c a_chuj(2,1,num_conti,i)= 0.0d0
2740 c a_chuj(2,2,num_conti,i)= 0.0d0
2742 C --- and its gradients
2743 cd write (iout,*) 'i',i,' j',j
2745 cd write (iout,*) 'iii 1 kkk',kkk
2746 cd write (iout,*) agg(kkk,:)
2749 cd write (iout,*) 'iii 2 kkk',kkk
2750 cd write (iout,*) aggi(kkk,:)
2753 cd write (iout,*) 'iii 3 kkk',kkk
2754 cd write (iout,*) aggi1(kkk,:)
2757 cd write (iout,*) 'iii 4 kkk',kkk
2758 cd write (iout,*) aggj(kkk,:)
2761 cd write (iout,*) 'iii 5 kkk',kkk
2762 cd write (iout,*) aggj1(kkk,:)
2769 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2770 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2771 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2772 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2773 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2775 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2781 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2782 C Calculate contact energies
2784 wij=cosa-3.0D0*cosb*cosg
2787 c fac3=dsqrt(-ael6i)/r0ij**3
2788 fac3=dsqrt(-ael6i)*r3ij
2789 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2790 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2791 if (shield_mode.eq.0) then
2795 ees0plist(num_conti,i)=j
2796 C fac_shield(i)=0.4d0
2797 C fac_shield(j)=0.6d0
2800 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2801 & *fac_shield(i)*fac_shield(j)
2803 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2804 & *fac_shield(i)*fac_shield(j)
2806 C Diagnostics. Comment out or remove after debugging!
2807 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2808 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2809 c ees0m(num_conti,i)=0.0D0
2811 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2812 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2813 facont_hb(num_conti,i)=fcont
2815 C Angular derivatives of the contact function
2816 ees0pij1=fac3/ees0pij
2817 ees0mij1=fac3/ees0mij
2818 fac3p=-3.0D0*fac3*rrmij
2819 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2820 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2822 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2823 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2824 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2825 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2826 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2827 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2828 ecosap=ecosa1+ecosa2
2829 ecosbp=ecosb1+ecosb2
2830 ecosgp=ecosg1+ecosg2
2831 ecosam=ecosa1-ecosa2
2832 ecosbm=ecosb1-ecosb2
2833 ecosgm=ecosg1-ecosg2
2842 fprimcont=fprimcont/rij
2843 cd facont_hb(num_conti,i)=1.0D0
2844 C Following line is for diagnostics.
2847 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2848 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2851 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2852 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2854 gggp(1)=gggp(1)+ees0pijp*xj
2855 gggp(2)=gggp(2)+ees0pijp*yj
2856 gggp(3)=gggp(3)+ees0pijp*zj
2857 gggm(1)=gggm(1)+ees0mijp*xj
2858 gggm(2)=gggm(2)+ees0mijp*yj
2859 gggm(3)=gggm(3)+ees0mijp*zj
2860 C Derivatives due to the contact function
2861 gacont_hbr(1,num_conti,i)=fprimcont*xj
2862 gacont_hbr(2,num_conti,i)=fprimcont*yj
2863 gacont_hbr(3,num_conti,i)=fprimcont*zj
2865 ghalfp=0.5D0*gggp(k)
2866 ghalfm=0.5D0*gggm(k)
2867 gacontp_hb1(k,num_conti,i)=ghalfp
2868 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2869 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2870 & *fac_shield(i)*fac_shield(j)
2872 gacontp_hb2(k,num_conti,i)=ghalfp
2873 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2874 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2875 & *fac_shield(i)*fac_shield(j)
2877 gacontp_hb3(k,num_conti,i)=gggp(k)
2878 & *fac_shield(i)*fac_shield(j)
2880 gacontm_hb1(k,num_conti,i)=ghalfm
2881 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2882 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2883 & *fac_shield(i)*fac_shield(j)
2885 gacontm_hb2(k,num_conti,i)=ghalfm
2886 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2887 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2888 & *fac_shield(i)*fac_shield(j)
2890 gacontm_hb3(k,num_conti,i)=gggm(k)
2891 & *fac_shield(i)*fac_shield(j)
2895 C Diagnostics. Comment out or remove after debugging!
2897 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2898 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2899 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2900 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2901 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2902 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2905 endif ! num_conti.le.maxconts
2910 num_cont_hb(i)=num_conti
2914 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2915 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2917 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2918 ccc eel_loc=eel_loc+eello_turn3
2921 C-----------------------------------------------------------------------------
2922 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2923 C Third- and fourth-order contributions from turns
2924 implicit real*8 (a-h,o-z)
2925 include 'DIMENSIONS'
2926 include 'sizesclu.dat'
2927 include 'COMMON.IOUNITS'
2928 include 'COMMON.GEO'
2929 include 'COMMON.VAR'
2930 include 'COMMON.LOCAL'
2931 include 'COMMON.CHAIN'
2932 include 'COMMON.DERIV'
2933 include 'COMMON.INTERACT'
2934 include 'COMMON.CONTACTS'
2935 include 'COMMON.TORSION'
2936 include 'COMMON.VECTORS'
2937 include 'COMMON.FFIELD'
2938 include 'COMMON.SHIELD'
2939 include 'COMMON.CONTROL'
2942 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2943 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2944 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2945 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2946 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2947 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2949 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2950 C changes suggested by Ana to avoid out of bounds
2951 C & .or.((i+5).gt.nres)
2952 C & .or.((i-1).le.0)
2953 C end of changes suggested by Ana
2954 & .or. itype(i+2).eq.ntyp1
2955 & .or. itype(i+3).eq.ntyp1
2956 C & .or. itype(i+5).eq.ntyp1
2957 C & .or. itype(i).eq.ntyp1
2958 C & .or. itype(i-1).eq.ntyp1
2961 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2963 C Third-order contributions
2970 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2971 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2972 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2973 call transpose2(auxmat(1,1),auxmat1(1,1))
2974 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2975 if (shield_mode.eq.0) then
2982 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2983 & *fac_shield(i)*fac_shield(j)
2984 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
2985 & *fac_shield(i)*fac_shield(j)
2987 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2988 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2989 cd & ' eello_turn3_num',4*eello_turn3_num
2991 C Derivatives in shield mode
2992 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2993 & (shield_mode.gt.0)) then
2996 do ilist=1,ishield_list(i)
2997 iresshield=shield_list(ilist,i)
2999 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3001 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3003 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3004 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3008 do ilist=1,ishield_list(j)
3009 iresshield=shield_list(ilist,j)
3011 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3013 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3015 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3016 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3023 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3024 & grad_shield(k,i)*eello_t3/fac_shield(i)
3025 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3026 & grad_shield(k,j)*eello_t3/fac_shield(j)
3027 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3028 & grad_shield(k,i)*eello_t3/fac_shield(i)
3029 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3030 & grad_shield(k,j)*eello_t3/fac_shield(j)
3034 C Derivatives in gamma(i)
3035 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3036 call transpose2(auxmat2(1,1),pizda(1,1))
3037 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3038 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3039 & *fac_shield(i)*fac_shield(j)
3041 C Derivatives in gamma(i+1)
3042 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3043 call transpose2(auxmat2(1,1),pizda(1,1))
3044 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3045 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3046 & +0.5d0*(pizda(1,1)+pizda(2,2))
3047 & *fac_shield(i)*fac_shield(j)
3049 C Cartesian derivatives
3051 a_temp(1,1)=aggi(l,1)
3052 a_temp(1,2)=aggi(l,2)
3053 a_temp(2,1)=aggi(l,3)
3054 a_temp(2,2)=aggi(l,4)
3055 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3056 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3057 & +0.5d0*(pizda(1,1)+pizda(2,2))
3058 & *fac_shield(i)*fac_shield(j)
3060 a_temp(1,1)=aggi1(l,1)
3061 a_temp(1,2)=aggi1(l,2)
3062 a_temp(2,1)=aggi1(l,3)
3063 a_temp(2,2)=aggi1(l,4)
3064 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3065 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3066 & +0.5d0*(pizda(1,1)+pizda(2,2))
3067 & *fac_shield(i)*fac_shield(j)
3069 a_temp(1,1)=aggj(l,1)
3070 a_temp(1,2)=aggj(l,2)
3071 a_temp(2,1)=aggj(l,3)
3072 a_temp(2,2)=aggj(l,4)
3073 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3074 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3075 & +0.5d0*(pizda(1,1)+pizda(2,2))
3076 & *fac_shield(i)*fac_shield(j)
3078 a_temp(1,1)=aggj1(l,1)
3079 a_temp(1,2)=aggj1(l,2)
3080 a_temp(2,1)=aggj1(l,3)
3081 a_temp(2,2)=aggj1(l,4)
3082 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3083 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3084 & +0.5d0*(pizda(1,1)+pizda(2,2))
3085 & *fac_shield(i)*fac_shield(j)
3090 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3091 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3092 C changes suggested by Ana to avoid out of bounds
3093 C & .or.((i+5).gt.nres)
3094 C & .or.((i-1).le.0)
3095 C end of changes suggested by Ana
3096 & .or. itype(i+3).eq.ntyp1
3097 & .or. itype(i+4).eq.ntyp1
3098 C & .or. itype(i+5).eq.ntyp1
3099 & .or. itype(i).eq.ntyp1
3100 C & .or. itype(i-1).eq.ntyp1
3103 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3105 C Fourth-order contributions
3113 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3114 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3115 iti1=itortyp(itype(i+1))
3116 iti2=itortyp(itype(i+2))
3117 iti3=itortyp(itype(i+3))
3118 call transpose2(EUg(1,1,i+1),e1t(1,1))
3119 call transpose2(Eug(1,1,i+2),e2t(1,1))
3120 call transpose2(Eug(1,1,i+3),e3t(1,1))
3121 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3122 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3123 s1=scalar2(b1(1,iti2),auxvec(1))
3124 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3125 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3126 s2=scalar2(b1(1,iti1),auxvec(1))
3127 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3128 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3129 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3130 if (shield_mode.eq.0) then
3137 eello_turn4=eello_turn4-(s1+s2+s3)
3138 & *fac_shield(i)*fac_shield(j)
3139 eello_t4=-(s1+s2+s3)
3140 & *fac_shield(i)*fac_shield(j)
3142 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3143 cd & ' eello_turn4_num',8*eello_turn4_num
3144 C Derivatives in gamma(i)
3146 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3147 & (shield_mode.gt.0)) then
3150 do ilist=1,ishield_list(i)
3151 iresshield=shield_list(ilist,i)
3153 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3155 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3157 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3158 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3162 do ilist=1,ishield_list(j)
3163 iresshield=shield_list(ilist,j)
3165 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3167 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3169 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3170 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3177 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3178 & grad_shield(k,i)*eello_t4/fac_shield(i)
3179 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3180 & grad_shield(k,j)*eello_t4/fac_shield(j)
3181 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3182 & grad_shield(k,i)*eello_t4/fac_shield(i)
3183 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3184 & grad_shield(k,j)*eello_t4/fac_shield(j)
3188 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3189 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3190 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3191 s1=scalar2(b1(1,iti2),auxvec(1))
3192 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3193 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3194 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3195 & *fac_shield(i)*fac_shield(j)
3197 C Derivatives in gamma(i+1)
3198 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3199 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3200 s2=scalar2(b1(1,iti1),auxvec(1))
3201 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3202 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3203 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3204 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3205 & *fac_shield(i)*fac_shield(j)
3207 C Derivatives in gamma(i+2)
3208 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3209 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3210 s1=scalar2(b1(1,iti2),auxvec(1))
3211 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3212 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3213 s2=scalar2(b1(1,iti1),auxvec(1))
3214 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3215 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3216 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3217 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3218 & *fac_shield(i)*fac_shield(j)
3220 C Cartesian derivatives
3221 C Derivatives of this turn contributions in DC(i+2)
3222 if (j.lt.nres-1) then
3224 a_temp(1,1)=agg(l,1)
3225 a_temp(1,2)=agg(l,2)
3226 a_temp(2,1)=agg(l,3)
3227 a_temp(2,2)=agg(l,4)
3228 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3229 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3230 s1=scalar2(b1(1,iti2),auxvec(1))
3231 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3232 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3233 s2=scalar2(b1(1,iti1),auxvec(1))
3234 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3235 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3236 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3238 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3239 & *fac_shield(i)*fac_shield(j)
3243 C Remaining derivatives of this turn contribution
3245 a_temp(1,1)=aggi(l,1)
3246 a_temp(1,2)=aggi(l,2)
3247 a_temp(2,1)=aggi(l,3)
3248 a_temp(2,2)=aggi(l,4)
3249 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3250 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3251 s1=scalar2(b1(1,iti2),auxvec(1))
3252 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3253 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3254 s2=scalar2(b1(1,iti1),auxvec(1))
3255 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3256 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3257 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3258 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3259 & *fac_shield(i)*fac_shield(j)
3261 a_temp(1,1)=aggi1(l,1)
3262 a_temp(1,2)=aggi1(l,2)
3263 a_temp(2,1)=aggi1(l,3)
3264 a_temp(2,2)=aggi1(l,4)
3265 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3266 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3267 s1=scalar2(b1(1,iti2),auxvec(1))
3268 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3269 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3270 s2=scalar2(b1(1,iti1),auxvec(1))
3271 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3272 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3273 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3274 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3275 & *fac_shield(i)*fac_shield(j)
3277 a_temp(1,1)=aggj(l,1)
3278 a_temp(1,2)=aggj(l,2)
3279 a_temp(2,1)=aggj(l,3)
3280 a_temp(2,2)=aggj(l,4)
3281 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3282 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3283 s1=scalar2(b1(1,iti2),auxvec(1))
3284 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3285 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3286 s2=scalar2(b1(1,iti1),auxvec(1))
3287 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3288 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3289 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3290 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3291 & *fac_shield(i)*fac_shield(j)
3293 a_temp(1,1)=aggj1(l,1)
3294 a_temp(1,2)=aggj1(l,2)
3295 a_temp(2,1)=aggj1(l,3)
3296 a_temp(2,2)=aggj1(l,4)
3297 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3298 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3299 s1=scalar2(b1(1,iti2),auxvec(1))
3300 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3301 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3302 s2=scalar2(b1(1,iti1),auxvec(1))
3303 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3304 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3305 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3306 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3307 & *fac_shield(i)*fac_shield(j)
3315 C-----------------------------------------------------------------------------
3316 subroutine vecpr(u,v,w)
3317 implicit real*8(a-h,o-z)
3318 dimension u(3),v(3),w(3)
3319 w(1)=u(2)*v(3)-u(3)*v(2)
3320 w(2)=-u(1)*v(3)+u(3)*v(1)
3321 w(3)=u(1)*v(2)-u(2)*v(1)
3324 C-----------------------------------------------------------------------------
3325 subroutine unormderiv(u,ugrad,unorm,ungrad)
3326 C This subroutine computes the derivatives of a normalized vector u, given
3327 C the derivatives computed without normalization conditions, ugrad. Returns
3330 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3331 double precision vec(3)
3332 double precision scalar
3334 c write (2,*) 'ugrad',ugrad
3337 vec(i)=scalar(ugrad(1,i),u(1))
3339 c write (2,*) 'vec',vec
3342 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3345 c write (2,*) 'ungrad',ungrad
3348 C-----------------------------------------------------------------------------
3349 subroutine escp(evdw2,evdw2_14)
3351 C This subroutine calculates the excluded-volume interaction energy between
3352 C peptide-group centers and side chains and its gradient in virtual-bond and
3353 C side-chain vectors.
3355 implicit real*8 (a-h,o-z)
3356 include 'DIMENSIONS'
3357 include 'sizesclu.dat'
3358 include 'COMMON.GEO'
3359 include 'COMMON.VAR'
3360 include 'COMMON.LOCAL'
3361 include 'COMMON.CHAIN'
3362 include 'COMMON.DERIV'
3363 include 'COMMON.INTERACT'
3364 include 'COMMON.FFIELD'
3365 include 'COMMON.IOUNITS'
3369 cd print '(a)','Enter ESCP'
3370 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3371 c & ' scal14',scal14
3372 do i=iatscp_s,iatscp_e
3373 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3375 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3376 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3377 if (iteli.eq.0) goto 1225
3378 xi=0.5D0*(c(1,i)+c(1,i+1))
3379 yi=0.5D0*(c(2,i)+c(2,i+1))
3380 zi=0.5D0*(c(3,i)+c(3,i+1))
3381 C Returning the ith atom to box
3383 if (xi.lt.0) xi=xi+boxxsize
3385 if (yi.lt.0) yi=yi+boxysize
3387 if (zi.lt.0) zi=zi+boxzsize
3389 do iint=1,nscp_gr(i)
3391 do j=iscpstart(i,iint),iscpend(i,iint)
3392 itypj=iabs(itype(j))
3393 if (itypj.eq.ntyp1) cycle
3394 C Uncomment following three lines for SC-p interactions
3398 C Uncomment following three lines for Ca-p interactions
3402 C returning the jth atom to box
3404 if (xj.lt.0) xj=xj+boxxsize
3406 if (yj.lt.0) yj=yj+boxysize
3408 if (zj.lt.0) zj=zj+boxzsize
3409 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3414 C Finding the closest jth atom
3418 xj=xj_safe+xshift*boxxsize
3419 yj=yj_safe+yshift*boxysize
3420 zj=zj_safe+zshift*boxzsize
3421 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3422 if(dist_temp.lt.dist_init) then
3432 if (subchap.eq.1) then
3442 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3443 C sss is scaling function for smoothing the cutoff gradient otherwise
3444 C the gradient would not be continuouse
3445 sss=sscale(1.0d0/(dsqrt(rrij)))
3446 if (sss.le.0.0d0) cycle
3447 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3449 e1=fac*fac*aad(itypj,iteli)
3450 e2=fac*bad(itypj,iteli)
3451 if (iabs(j-i) .le. 2) then
3454 evdw2_14=evdw2_14+(e1+e2)*sss
3457 c write (iout,*) i,j,evdwij
3458 evdw2=evdw2+evdwij*sss
3461 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3463 fac=-(evdwij+e1)*rrij*sss
3464 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3469 cd write (iout,*) 'j<i'
3470 C Uncomment following three lines for SC-p interactions
3472 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3475 cd write (iout,*) 'j>i'
3478 C Uncomment following line for SC-p interactions
3479 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3483 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3487 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3488 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3491 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3501 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3502 gradx_scp(j,i)=expon*gradx_scp(j,i)
3505 C******************************************************************************
3509 C To save time the factor EXPON has been extracted from ALL components
3510 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3513 C******************************************************************************
3516 C--------------------------------------------------------------------------
3517 subroutine edis(ehpb)
3519 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3521 implicit real*8 (a-h,o-z)
3522 include 'DIMENSIONS'
3523 include 'sizesclu.dat'
3524 include 'COMMON.SBRIDGE'
3525 include 'COMMON.CHAIN'
3526 include 'COMMON.DERIV'
3527 include 'COMMON.VAR'
3528 include 'COMMON.INTERACT'
3529 include 'COMMON.CONTROL'
3532 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3533 cd print *,'link_start=',link_start,' link_end=',link_end
3534 if (link_end.eq.0) return
3535 do i=link_start,link_end
3536 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3537 C CA-CA distance used in regularization of structure.
3540 C iii and jjj point to the residues for which the distance is assigned.
3541 if (ii.gt.nres) then
3548 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3549 C distance and angle dependent SS bond potential.
3550 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3551 C & iabs(itype(jjj)).eq.1) then
3552 C call ssbond_ene(iii,jjj,eij)
3555 if (.not.dyn_ss .and. i.le.nss) then
3556 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3557 & iabs(itype(jjj)).eq.1) then
3558 call ssbond_ene(iii,jjj,eij)
3561 else if (ii.gt.nres .and. jj.gt.nres) then
3562 c Restraints from contact prediction
3564 if (constr_dist.eq.11) then
3565 C ehpb=ehpb+fordepth(i)**4.0d0
3566 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3567 ehpb=ehpb+fordepth(i)**4.0d0
3568 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3569 fac=fordepth(i)**4.0d0
3570 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3571 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3572 C & ehpb,fordepth(i),dd
3574 C write(iout,*) ehpb,"atu?"
3576 C fac=fordepth(i)**4.0d0
3577 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3578 else !constr_dist.eq.11
3579 if (dhpb1(i).gt.0.0d0) then
3580 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3581 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3582 c write (iout,*) "beta nmr",
3583 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3584 else !dhpb(i).gt.0.00
3586 C Calculate the distance between the two points and its difference from the
3590 C Get the force constant corresponding to this distance.
3592 C Calculate the contribution to energy.
3593 ehpb=ehpb+waga*rdis*rdis
3595 C Evaluate gradient.
3600 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3601 cd & ' waga=',waga,' fac=',fac
3603 ggg(j)=fac*(c(j,jj)-c(j,ii))
3605 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3606 C If this is a SC-SC distance, we need to calculate the contributions to the
3607 C Cartesian gradient in the SC vectors (ghpbx).
3610 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3611 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3615 C write(iout,*) "before"
3617 C write(iout,*) "after",dd
3618 if (constr_dist.eq.11) then
3619 ehpb=ehpb+fordepth(i)**4.0d0
3620 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3621 fac=fordepth(i)**4.0d0
3622 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3623 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3624 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3625 C print *,ehpb,"tu?"
3626 C write(iout,*) ehpb,"btu?",
3627 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3628 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3629 C & ehpb,fordepth(i),dd
3631 if (dhpb1(i).gt.0.0d0) then
3632 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3633 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3634 c write (iout,*) "alph nmr",
3635 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3638 C Get the force constant corresponding to this distance.
3640 C Calculate the contribution to energy.
3641 ehpb=ehpb+waga*rdis*rdis
3642 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3644 C Evaluate gradient.
3650 ggg(j)=fac*(c(j,jj)-c(j,ii))
3652 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3653 C If this is a SC-SC distance, we need to calculate the contributions to the
3654 C Cartesian gradient in the SC vectors (ghpbx).
3657 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3658 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3663 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3668 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3671 C--------------------------------------------------------------------------
3672 subroutine ssbond_ene(i,j,eij)
3674 C Calculate the distance and angle dependent SS-bond potential energy
3675 C using a free-energy function derived based on RHF/6-31G** ab initio
3676 C calculations of diethyl disulfide.
3678 C A. Liwo and U. Kozlowska, 11/24/03
3680 implicit real*8 (a-h,o-z)
3681 include 'DIMENSIONS'
3682 include 'sizesclu.dat'
3683 include 'COMMON.SBRIDGE'
3684 include 'COMMON.CHAIN'
3685 include 'COMMON.DERIV'
3686 include 'COMMON.LOCAL'
3687 include 'COMMON.INTERACT'
3688 include 'COMMON.VAR'
3689 include 'COMMON.IOUNITS'
3690 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3691 itypi=iabs(itype(i))
3695 dxi=dc_norm(1,nres+i)
3696 dyi=dc_norm(2,nres+i)
3697 dzi=dc_norm(3,nres+i)
3698 dsci_inv=dsc_inv(itypi)
3699 itypj=iabs(itype(j))
3700 dscj_inv=dsc_inv(itypj)
3704 dxj=dc_norm(1,nres+j)
3705 dyj=dc_norm(2,nres+j)
3706 dzj=dc_norm(3,nres+j)
3707 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3712 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3713 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3714 om12=dxi*dxj+dyi*dyj+dzi*dzj
3716 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3717 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3723 deltat12=om2-om1+2.0d0
3725 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3726 & +akct*deltad*deltat12
3727 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3728 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3729 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3730 c & " deltat12",deltat12," eij",eij
3731 ed=2*akcm*deltad+akct*deltat12
3733 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3734 eom1=-2*akth*deltat1-pom1-om2*pom2
3735 eom2= 2*akth*deltat2+pom1-om1*pom2
3738 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3741 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3742 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3743 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3744 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3747 C Calculate the components of the gradient in DC and X
3751 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3756 C--------------------------------------------------------------------------
3757 subroutine ebond(estr)
3759 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3761 implicit real*8 (a-h,o-z)
3762 include 'DIMENSIONS'
3763 include 'sizesclu.dat'
3764 include 'COMMON.LOCAL'
3765 include 'COMMON.GEO'
3766 include 'COMMON.INTERACT'
3767 include 'COMMON.DERIV'
3768 include 'COMMON.VAR'
3769 include 'COMMON.CHAIN'
3770 include 'COMMON.IOUNITS'
3771 include 'COMMON.NAMES'
3772 include 'COMMON.FFIELD'
3773 include 'COMMON.CONTROL'
3774 logical energy_dec /.false./
3775 double precision u(3),ud(3)
3779 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3780 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3782 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3783 C & *dc(j,i-1)/vbld(i)
3785 C if (energy_dec) write(iout,*)
3786 C & "estr1",i,vbld(i),distchainmax,
3787 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3789 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3790 diff = vbld(i)-vbldpDUM
3792 diff = vbld(i)-vbldp0
3793 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3797 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3800 C write (iout,'(a7,i5,4f7.3)')
3801 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3803 estr=0.5d0*AKP*estr+estr1
3805 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3809 if (iti.ne.10 .and. iti.ne.ntyp1) then
3812 diff=vbld(i+nres)-vbldsc0(1,iti)
3813 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3814 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3815 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3817 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3821 diff=vbld(i+nres)-vbldsc0(j,iti)
3822 ud(j)=aksc(j,iti)*diff
3823 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3837 uprod2=uprod2*u(k)*u(k)
3841 usumsqder=usumsqder+ud(j)*uprod2
3843 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3844 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3845 estr=estr+uprod/usum
3847 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3855 C--------------------------------------------------------------------------
3856 subroutine ebend(etheta,ethetacnstr)
3858 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3859 C angles gamma and its derivatives in consecutive thetas and gammas.
3861 implicit real*8 (a-h,o-z)
3862 include 'DIMENSIONS'
3863 include 'sizesclu.dat'
3864 include 'COMMON.LOCAL'
3865 include 'COMMON.GEO'
3866 include 'COMMON.INTERACT'
3867 include 'COMMON.DERIV'
3868 include 'COMMON.VAR'
3869 include 'COMMON.CHAIN'
3870 include 'COMMON.IOUNITS'
3871 include 'COMMON.NAMES'
3872 include 'COMMON.FFIELD'
3873 include 'COMMON.TORCNSTR'
3874 common /calcthet/ term1,term2,termm,diffak,ratak,
3875 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3876 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3877 double precision y(2),z(2)
3879 c time11=dexp(-2*time)
3882 c write (iout,*) "nres",nres
3883 c write (*,'(a,i2)') 'EBEND ICG=',icg
3884 c write (iout,*) ithet_start,ithet_end
3885 do i=ithet_start,ithet_end
3887 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3888 & .or.itype(i).eq.ntyp1) cycle
3889 C Zero the energy function and its derivative at 0 or pi.
3890 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3892 ichir1=isign(1,itype(i-2))
3893 ichir2=isign(1,itype(i))
3894 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3895 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3896 if (itype(i-1).eq.10) then
3897 itype1=isign(10,itype(i-2))
3898 ichir11=isign(1,itype(i-2))
3899 ichir12=isign(1,itype(i-2))
3900 itype2=isign(10,itype(i))
3901 ichir21=isign(1,itype(i))
3902 ichir22=isign(1,itype(i))
3908 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3912 c call proc_proc(phii,icrc)
3913 if (icrc.eq.1) phii=150.0
3924 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3928 c call proc_proc(phii1,icrc)
3929 if (icrc.eq.1) phii1=150.0
3941 C Calculate the "mean" value of theta from the part of the distribution
3942 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3943 C In following comments this theta will be referred to as t_c.
3944 thet_pred_mean=0.0d0
3946 athetk=athet(k,it,ichir1,ichir2)
3947 bthetk=bthet(k,it,ichir1,ichir2)
3949 athetk=athet(k,itype1,ichir11,ichir12)
3950 bthetk=bthet(k,itype2,ichir21,ichir22)
3952 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3954 c write (iout,*) "thet_pred_mean",thet_pred_mean
3955 dthett=thet_pred_mean*ssd
3956 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3957 c write (iout,*) "thet_pred_mean",thet_pred_mean
3958 C Derivatives of the "mean" values in gamma1 and gamma2.
3959 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3960 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3961 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3962 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3964 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3965 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3966 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3967 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3969 if (theta(i).gt.pi-delta) then
3970 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3972 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3973 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3974 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3976 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3978 else if (theta(i).lt.delta) then
3979 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3980 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3981 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3983 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3984 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3987 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3990 etheta=etheta+ethetai
3991 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3992 c & rad2deg*phii,rad2deg*phii1,ethetai
3993 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3994 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3995 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3998 C Ufff.... We've done all this!!!
4001 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4002 do i=1,ntheta_constr
4003 itheta=itheta_constr(i)
4004 thetiii=theta(itheta)
4005 difi=pinorm(thetiii-theta_constr0(i))
4006 if (difi.gt.theta_drange(i)) then
4007 difi=difi-theta_drange(i)
4008 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4009 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4010 & +for_thet_constr(i)*difi**3
4011 else if (difi.lt.-drange(i)) then
4013 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4014 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4015 & +for_thet_constr(i)*difi**3
4019 C if (energy_dec) then
4020 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4021 C & i,itheta,rad2deg*thetiii,
4022 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4023 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4024 C & gloc(itheta+nphi-2,icg)
4029 C---------------------------------------------------------------------------
4030 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4032 implicit real*8 (a-h,o-z)
4033 include 'DIMENSIONS'
4034 include 'COMMON.LOCAL'
4035 include 'COMMON.IOUNITS'
4036 common /calcthet/ term1,term2,termm,diffak,ratak,
4037 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4038 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4039 C Calculate the contributions to both Gaussian lobes.
4040 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4041 C The "polynomial part" of the "standard deviation" of this part of
4045 sig=sig*thet_pred_mean+polthet(j,it)
4047 C Derivative of the "interior part" of the "standard deviation of the"
4048 C gamma-dependent Gaussian lobe in t_c.
4049 sigtc=3*polthet(3,it)
4051 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4054 C Set the parameters of both Gaussian lobes of the distribution.
4055 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4056 fac=sig*sig+sigc0(it)
4059 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4060 sigsqtc=-4.0D0*sigcsq*sigtc
4061 c print *,i,sig,sigtc,sigsqtc
4062 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4063 sigtc=-sigtc/(fac*fac)
4064 C Following variable is sigma(t_c)**(-2)
4065 sigcsq=sigcsq*sigcsq
4067 sig0inv=1.0D0/sig0i**2
4068 delthec=thetai-thet_pred_mean
4069 delthe0=thetai-theta0i
4070 term1=-0.5D0*sigcsq*delthec*delthec
4071 term2=-0.5D0*sig0inv*delthe0*delthe0
4072 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4073 C NaNs in taking the logarithm. We extract the largest exponent which is added
4074 C to the energy (this being the log of the distribution) at the end of energy
4075 C term evaluation for this virtual-bond angle.
4076 if (term1.gt.term2) then
4078 term2=dexp(term2-termm)
4082 term1=dexp(term1-termm)
4085 C The ratio between the gamma-independent and gamma-dependent lobes of
4086 C the distribution is a Gaussian function of thet_pred_mean too.
4087 diffak=gthet(2,it)-thet_pred_mean
4088 ratak=diffak/gthet(3,it)**2
4089 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4090 C Let's differentiate it in thet_pred_mean NOW.
4092 C Now put together the distribution terms to make complete distribution.
4093 termexp=term1+ak*term2
4094 termpre=sigc+ak*sig0i
4095 C Contribution of the bending energy from this theta is just the -log of
4096 C the sum of the contributions from the two lobes and the pre-exponential
4097 C factor. Simple enough, isn't it?
4098 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4099 C NOW the derivatives!!!
4100 C 6/6/97 Take into account the deformation.
4101 E_theta=(delthec*sigcsq*term1
4102 & +ak*delthe0*sig0inv*term2)/termexp
4103 E_tc=((sigtc+aktc*sig0i)/termpre
4104 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4105 & aktc*term2)/termexp)
4108 c-----------------------------------------------------------------------------
4109 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4110 implicit real*8 (a-h,o-z)
4111 include 'DIMENSIONS'
4112 include 'COMMON.LOCAL'
4113 include 'COMMON.IOUNITS'
4114 common /calcthet/ term1,term2,termm,diffak,ratak,
4115 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4116 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4117 delthec=thetai-thet_pred_mean
4118 delthe0=thetai-theta0i
4119 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4120 t3 = thetai-thet_pred_mean
4124 t14 = t12+t6*sigsqtc
4126 t21 = thetai-theta0i
4132 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4133 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4134 & *(-t12*t9-ak*sig0inv*t27)
4138 C--------------------------------------------------------------------------
4139 subroutine ebend(etheta,ethetacnstr)
4141 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4142 C angles gamma and its derivatives in consecutive thetas and gammas.
4143 C ab initio-derived potentials from
4144 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4146 implicit real*8 (a-h,o-z)
4147 include 'DIMENSIONS'
4148 include 'sizesclu.dat'
4149 include 'COMMON.LOCAL'
4150 include 'COMMON.GEO'
4151 include 'COMMON.INTERACT'
4152 include 'COMMON.DERIV'
4153 include 'COMMON.VAR'
4154 include 'COMMON.CHAIN'
4155 include 'COMMON.IOUNITS'
4156 include 'COMMON.NAMES'
4157 include 'COMMON.FFIELD'
4158 include 'COMMON.CONTROL'
4159 include 'COMMON.TORCNSTR'
4160 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4161 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4162 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4163 & sinph1ph2(maxdouble,maxdouble)
4164 logical lprn /.false./, lprn1 /.false./
4166 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4167 do i=ithet_start,ithet_end
4169 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4170 & .or.itype(i).eq.ntyp1) cycle
4171 c if (itype(i-1).eq.ntyp1) cycle
4172 if (iabs(itype(i+1)).eq.20) iblock=2
4173 if (iabs(itype(i+1)).ne.20) iblock=1
4177 theti2=0.5d0*theta(i)
4178 ityp2=ithetyp((itype(i-1)))
4180 coskt(k)=dcos(k*theti2)
4181 sinkt(k)=dsin(k*theti2)
4191 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4194 if (phii.ne.phii) phii=150.0
4198 ityp1=ithetyp((itype(i-2)))
4200 cosph1(k)=dcos(k*phii)
4201 sinph1(k)=dsin(k*phii)
4207 ityp1=ithetyp((itype(i-2)))
4213 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4216 if (phii1.ne.phii1) phii1=150.0
4221 ityp3=ithetyp((itype(i)))
4223 cosph2(k)=dcos(k*phii1)
4224 sinph2(k)=dsin(k*phii1)
4229 ityp3=ithetyp((itype(i)))
4235 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4236 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4238 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4241 ccl=cosph1(l)*cosph2(k-l)
4242 ssl=sinph1(l)*sinph2(k-l)
4243 scl=sinph1(l)*cosph2(k-l)
4244 csl=cosph1(l)*sinph2(k-l)
4245 cosph1ph2(l,k)=ccl-ssl
4246 cosph1ph2(k,l)=ccl+ssl
4247 sinph1ph2(l,k)=scl+csl
4248 sinph1ph2(k,l)=scl-csl
4252 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4253 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4254 write (iout,*) "coskt and sinkt"
4256 write (iout,*) k,coskt(k),sinkt(k)
4260 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4261 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4264 & write (iout,*) "k",k," aathet",
4265 & aathet(k,ityp1,ityp2,ityp3,iblock),
4266 & " ethetai",ethetai
4269 write (iout,*) "cosph and sinph"
4271 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4273 write (iout,*) "cosph1ph2 and sinph2ph2"
4276 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4277 & sinph1ph2(l,k),sinph1ph2(k,l)
4280 write(iout,*) "ethetai",ethetai
4284 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4285 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4286 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4287 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4288 ethetai=ethetai+sinkt(m)*aux
4289 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4290 dephii=dephii+k*sinkt(m)*(
4291 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4292 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4293 dephii1=dephii1+k*sinkt(m)*(
4294 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4295 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4297 & write (iout,*) "m",m," k",k," bbthet",
4298 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4299 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4300 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4301 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4305 & write(iout,*) "ethetai",ethetai
4309 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4310 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4311 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4312 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4313 ethetai=ethetai+sinkt(m)*aux
4314 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4315 dephii=dephii+l*sinkt(m)*(
4316 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4317 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4318 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4319 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4320 dephii1=dephii1+(k-l)*sinkt(m)*(
4321 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4322 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4323 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4324 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4326 write (iout,*) "m",m," k",k," l",l," ffthet",
4327 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4328 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4329 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4330 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4331 & " ethetai",ethetai
4332 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4333 & cosph1ph2(k,l)*sinkt(m),
4334 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4340 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4341 & i,theta(i)*rad2deg,phii*rad2deg,
4342 & phii1*rad2deg,ethetai
4343 etheta=etheta+ethetai
4344 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4345 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4346 c gloc(nphi+i-2,icg)=wang*dethetai
4347 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4351 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4352 do i=1,ntheta_constr
4353 itheta=itheta_constr(i)
4354 thetiii=theta(itheta)
4355 difi=pinorm(thetiii-theta_constr0(i))
4356 if (difi.gt.theta_drange(i)) then
4357 difi=difi-theta_drange(i)
4358 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4359 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4360 & +for_thet_constr(i)*difi**3
4361 else if (difi.lt.-drange(i)) then
4363 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4364 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4365 & +for_thet_constr(i)*difi**3
4369 C if (energy_dec) then
4370 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4371 C & i,itheta,rad2deg*thetiii,
4372 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4373 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4374 C & gloc(itheta+nphi-2,icg)
4381 c-----------------------------------------------------------------------------
4382 subroutine esc(escloc)
4383 C Calculate the local energy of a side chain and its derivatives in the
4384 C corresponding virtual-bond valence angles THETA and the spherical angles
4386 implicit real*8 (a-h,o-z)
4387 include 'DIMENSIONS'
4388 include 'sizesclu.dat'
4389 include 'COMMON.GEO'
4390 include 'COMMON.LOCAL'
4391 include 'COMMON.VAR'
4392 include 'COMMON.INTERACT'
4393 include 'COMMON.DERIV'
4394 include 'COMMON.CHAIN'
4395 include 'COMMON.IOUNITS'
4396 include 'COMMON.NAMES'
4397 include 'COMMON.FFIELD'
4398 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4399 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4400 common /sccalc/ time11,time12,time112,theti,it,nlobit
4403 c write (iout,'(a)') 'ESC'
4404 do i=loc_start,loc_end
4406 if (it.eq.ntyp1) cycle
4407 if (it.eq.10) goto 1
4408 nlobit=nlob(iabs(it))
4409 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4410 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4411 theti=theta(i+1)-pipol
4415 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4417 if (x(2).gt.pi-delta) then
4421 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4423 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4424 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4426 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4427 & ddersc0(1),dersc(1))
4428 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4429 & ddersc0(3),dersc(3))
4431 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4433 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4434 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4435 & dersc0(2),esclocbi,dersc02)
4436 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4438 call splinthet(x(2),0.5d0*delta,ss,ssd)
4443 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4445 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4446 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4448 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4450 c write (iout,*) escloci
4451 else if (x(2).lt.delta) then
4455 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4457 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4458 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4460 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4461 & ddersc0(1),dersc(1))
4462 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4463 & ddersc0(3),dersc(3))
4465 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4467 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4468 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4469 & dersc0(2),esclocbi,dersc02)
4470 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4475 call splinthet(x(2),0.5d0*delta,ss,ssd)
4477 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4479 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4480 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4482 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4483 c write (iout,*) escloci
4485 call enesc(x,escloci,dersc,ddummy,.false.)
4488 escloc=escloc+escloci
4489 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4491 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4493 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4494 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4499 C---------------------------------------------------------------------------
4500 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4501 implicit real*8 (a-h,o-z)
4502 include 'DIMENSIONS'
4503 include 'COMMON.GEO'
4504 include 'COMMON.LOCAL'
4505 include 'COMMON.IOUNITS'
4506 common /sccalc/ time11,time12,time112,theti,it,nlobit
4507 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4508 double precision contr(maxlob,-1:1)
4510 c write (iout,*) 'it=',it,' nlobit=',nlobit
4514 if (mixed) ddersc(j)=0.0d0
4518 C Because of periodicity of the dependence of the SC energy in omega we have
4519 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4520 C To avoid underflows, first compute & store the exponents.
4528 z(k)=x(k)-censc(k,j,it)
4533 Axk=Axk+gaussc(l,k,j,it)*z(l)
4539 expfac=expfac+Ax(k,j,iii)*z(k)
4547 C As in the case of ebend, we want to avoid underflows in exponentiation and
4548 C subsequent NaNs and INFs in energy calculation.
4549 C Find the largest exponent
4553 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4557 cd print *,'it=',it,' emin=',emin
4559 C Compute the contribution to SC energy and derivatives
4563 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4564 cd print *,'j=',j,' expfac=',expfac
4565 escloc_i=escloc_i+expfac
4567 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4571 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4572 & +gaussc(k,2,j,it))*expfac
4579 dersc(1)=dersc(1)/cos(theti)**2
4580 ddersc(1)=ddersc(1)/cos(theti)**2
4583 escloci=-(dlog(escloc_i)-emin)
4585 dersc(j)=dersc(j)/escloc_i
4589 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4594 C------------------------------------------------------------------------------
4595 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4596 implicit real*8 (a-h,o-z)
4597 include 'DIMENSIONS'
4598 include 'COMMON.GEO'
4599 include 'COMMON.LOCAL'
4600 include 'COMMON.IOUNITS'
4601 common /sccalc/ time11,time12,time112,theti,it,nlobit
4602 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4603 double precision contr(maxlob)
4614 z(k)=x(k)-censc(k,j,it)
4620 Axk=Axk+gaussc(l,k,j,it)*z(l)
4626 expfac=expfac+Ax(k,j)*z(k)
4631 C As in the case of ebend, we want to avoid underflows in exponentiation and
4632 C subsequent NaNs and INFs in energy calculation.
4633 C Find the largest exponent
4636 if (emin.gt.contr(j)) emin=contr(j)
4640 C Compute the contribution to SC energy and derivatives
4644 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4645 escloc_i=escloc_i+expfac
4647 dersc(k)=dersc(k)+Ax(k,j)*expfac
4649 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4650 & +gaussc(1,2,j,it))*expfac
4654 dersc(1)=dersc(1)/cos(theti)**2
4655 dersc12=dersc12/cos(theti)**2
4656 escloci=-(dlog(escloc_i)-emin)
4658 dersc(j)=dersc(j)/escloc_i
4660 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4664 c----------------------------------------------------------------------------------
4665 subroutine esc(escloc)
4666 C Calculate the local energy of a side chain and its derivatives in the
4667 C corresponding virtual-bond valence angles THETA and the spherical angles
4668 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4669 C added by Urszula Kozlowska. 07/11/2007
4671 implicit real*8 (a-h,o-z)
4672 include 'DIMENSIONS'
4673 include 'sizesclu.dat'
4674 include 'COMMON.GEO'
4675 include 'COMMON.LOCAL'
4676 include 'COMMON.VAR'
4677 include 'COMMON.SCROT'
4678 include 'COMMON.INTERACT'
4679 include 'COMMON.DERIV'
4680 include 'COMMON.CHAIN'
4681 include 'COMMON.IOUNITS'
4682 include 'COMMON.NAMES'
4683 include 'COMMON.FFIELD'
4684 include 'COMMON.CONTROL'
4685 include 'COMMON.VECTORS'
4686 double precision x_prime(3),y_prime(3),z_prime(3)
4687 & , sumene,dsc_i,dp2_i,x(65),
4688 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4689 & de_dxx,de_dyy,de_dzz,de_dt
4690 double precision s1_t,s1_6_t,s2_t,s2_6_t
4692 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4693 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4694 & dt_dCi(3),dt_dCi1(3)
4695 common /sccalc/ time11,time12,time112,theti,it,nlobit
4698 do i=loc_start,loc_end
4699 if (itype(i).eq.ntyp1) cycle
4700 costtab(i+1) =dcos(theta(i+1))
4701 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4702 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4703 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4704 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4705 cosfac=dsqrt(cosfac2)
4706 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4707 sinfac=dsqrt(sinfac2)
4709 if (it.eq.10) goto 1
4711 C Compute the axes of tghe local cartesian coordinates system; store in
4712 c x_prime, y_prime and z_prime
4719 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4720 C & dc_norm(3,i+nres)
4722 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4723 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4726 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4729 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4730 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4731 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4732 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4733 c & " xy",scalar(x_prime(1),y_prime(1)),
4734 c & " xz",scalar(x_prime(1),z_prime(1)),
4735 c & " yy",scalar(y_prime(1),y_prime(1)),
4736 c & " yz",scalar(y_prime(1),z_prime(1)),
4737 c & " zz",scalar(z_prime(1),z_prime(1))
4739 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4740 C to local coordinate system. Store in xx, yy, zz.
4746 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4747 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4748 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4755 C Compute the energy of the ith side cbain
4757 c write (2,*) "xx",xx," yy",yy," zz",zz
4760 x(j) = sc_parmin(j,it)
4763 Cc diagnostics - remove later
4765 yy1 = dsin(alph(2))*dcos(omeg(2))
4766 c zz1 = -dsin(alph(2))*dsin(omeg(2))
4767 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4768 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4769 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4771 C," --- ", xx_w,yy_w,zz_w
4774 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4775 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4777 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4778 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4780 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4781 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4782 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4783 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4784 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4786 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4787 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4788 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4789 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4790 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4792 dsc_i = 0.743d0+x(61)
4794 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4795 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4796 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4797 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4798 s1=(1+x(63))/(0.1d0 + dscp1)
4799 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4800 s2=(1+x(65))/(0.1d0 + dscp2)
4801 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4802 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4803 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4804 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4806 c & dscp1,dscp2,sumene
4807 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4808 escloc = escloc + sumene
4809 c write (2,*) "escloc",escloc
4810 if (.not. calc_grad) goto 1
4813 C This section to check the numerical derivatives of the energy of ith side
4814 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4815 C #define DEBUG in the code to turn it on.
4817 write (2,*) "sumene =",sumene
4821 write (2,*) xx,yy,zz
4822 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4823 de_dxx_num=(sumenep-sumene)/aincr
4825 write (2,*) "xx+ sumene from enesc=",sumenep
4828 write (2,*) xx,yy,zz
4829 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4830 de_dyy_num=(sumenep-sumene)/aincr
4832 write (2,*) "yy+ sumene from enesc=",sumenep
4835 write (2,*) xx,yy,zz
4836 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4837 de_dzz_num=(sumenep-sumene)/aincr
4839 write (2,*) "zz+ sumene from enesc=",sumenep
4840 costsave=cost2tab(i+1)
4841 sintsave=sint2tab(i+1)
4842 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4843 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4844 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4845 de_dt_num=(sumenep-sumene)/aincr
4846 write (2,*) " t+ sumene from enesc=",sumenep
4847 cost2tab(i+1)=costsave
4848 sint2tab(i+1)=sintsave
4849 C End of diagnostics section.
4852 C Compute the gradient of esc
4854 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4855 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4856 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4857 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4858 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4859 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4860 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4861 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4862 pom1=(sumene3*sint2tab(i+1)+sumene1)
4863 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4864 pom2=(sumene4*cost2tab(i+1)+sumene2)
4865 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4866 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4867 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4868 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4870 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4871 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4872 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4874 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4875 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4876 & +(pom1+pom2)*pom_dx
4878 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4881 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4882 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4883 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4885 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4886 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4887 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4888 & +x(59)*zz**2 +x(60)*xx*zz
4889 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4890 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4891 & +(pom1-pom2)*pom_dy
4893 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4896 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4897 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4898 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4899 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4900 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4901 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4902 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4903 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4905 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4908 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4909 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4910 & +pom1*pom_dt1+pom2*pom_dt2
4912 write(2,*), "de_dt = ", de_dt,de_dt_num
4916 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4917 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4918 cosfac2xx=cosfac2*xx
4919 sinfac2yy=sinfac2*yy
4921 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4923 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4925 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4926 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4927 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4928 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4929 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4930 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4931 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4932 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4933 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4934 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4938 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4939 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4940 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4941 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4944 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4945 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4946 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4948 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4949 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4953 dXX_Ctab(k,i)=dXX_Ci(k)
4954 dXX_C1tab(k,i)=dXX_Ci1(k)
4955 dYY_Ctab(k,i)=dYY_Ci(k)
4956 dYY_C1tab(k,i)=dYY_Ci1(k)
4957 dZZ_Ctab(k,i)=dZZ_Ci(k)
4958 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4959 dXX_XYZtab(k,i)=dXX_XYZ(k)
4960 dYY_XYZtab(k,i)=dYY_XYZ(k)
4961 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4965 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4966 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4967 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4968 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4969 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4971 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4972 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4973 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4974 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4975 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4976 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4977 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4978 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4980 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4981 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4983 C to check gradient call subroutine check_grad
4990 c------------------------------------------------------------------------------
4991 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4993 C This procedure calculates two-body contact function g(rij) and its derivative:
4996 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4999 C where x=(rij-r0ij)/delta
5001 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5004 double precision rij,r0ij,eps0ij,fcont,fprimcont
5005 double precision x,x2,x4,delta
5009 if (x.lt.-1.0D0) then
5012 else if (x.le.1.0D0) then
5015 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5016 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5023 c------------------------------------------------------------------------------
5024 subroutine splinthet(theti,delta,ss,ssder)
5025 implicit real*8 (a-h,o-z)
5026 include 'DIMENSIONS'
5027 include 'sizesclu.dat'
5028 include 'COMMON.VAR'
5029 include 'COMMON.GEO'
5032 if (theti.gt.pipol) then
5033 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5035 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5040 c------------------------------------------------------------------------------
5041 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5043 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5044 double precision ksi,ksi2,ksi3,a1,a2,a3
5045 a1=fprim0*delta/(f1-f0)
5051 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5052 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5055 c------------------------------------------------------------------------------
5056 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5058 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5059 double precision ksi,ksi2,ksi3,a1,a2,a3
5064 a2=3*(f1x-f0x)-2*fprim0x*delta
5065 a3=fprim0x*delta-2*(f1x-f0x)
5066 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5069 C-----------------------------------------------------------------------------
5071 C-----------------------------------------------------------------------------
5072 subroutine etor(etors,edihcnstr,fact)
5073 implicit real*8 (a-h,o-z)
5074 include 'DIMENSIONS'
5075 include 'sizesclu.dat'
5076 include 'COMMON.VAR'
5077 include 'COMMON.GEO'
5078 include 'COMMON.LOCAL'
5079 include 'COMMON.TORSION'
5080 include 'COMMON.INTERACT'
5081 include 'COMMON.DERIV'
5082 include 'COMMON.CHAIN'
5083 include 'COMMON.NAMES'
5084 include 'COMMON.IOUNITS'
5085 include 'COMMON.FFIELD'
5086 include 'COMMON.TORCNSTR'
5088 C Set lprn=.true. for debugging
5092 do i=iphi_start,iphi_end
5093 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5094 & .or. itype(i).eq.ntyp1) cycle
5095 itori=itortyp(itype(i-2))
5096 itori1=itortyp(itype(i-1))
5099 C Proline-Proline pair is a special case...
5100 if (itori.eq.3 .and. itori1.eq.3) then
5101 if (phii.gt.-dwapi3) then
5103 fac=1.0D0/(1.0D0-cosphi)
5104 etorsi=v1(1,3,3)*fac
5105 etorsi=etorsi+etorsi
5106 etors=etors+etorsi-v1(1,3,3)
5107 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5110 v1ij=v1(j+1,itori,itori1)
5111 v2ij=v2(j+1,itori,itori1)
5114 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5115 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5119 v1ij=v1(j,itori,itori1)
5120 v2ij=v2(j,itori,itori1)
5123 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5124 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5128 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5129 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5130 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5131 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5132 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5134 ! 6/20/98 - dihedral angle constraints
5137 itori=idih_constr(i)
5140 if (difi.gt.drange(i)) then
5142 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5143 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5144 else if (difi.lt.-drange(i)) then
5146 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5147 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5149 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5150 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5152 ! write (iout,*) 'edihcnstr',edihcnstr
5155 c------------------------------------------------------------------------------
5157 subroutine etor(etors,edihcnstr,fact)
5158 implicit real*8 (a-h,o-z)
5159 include 'DIMENSIONS'
5160 include 'sizesclu.dat'
5161 include 'COMMON.VAR'
5162 include 'COMMON.GEO'
5163 include 'COMMON.LOCAL'
5164 include 'COMMON.TORSION'
5165 include 'COMMON.INTERACT'
5166 include 'COMMON.DERIV'
5167 include 'COMMON.CHAIN'
5168 include 'COMMON.NAMES'
5169 include 'COMMON.IOUNITS'
5170 include 'COMMON.FFIELD'
5171 include 'COMMON.TORCNSTR'
5173 C Set lprn=.true. for debugging
5177 do i=iphi_start,iphi_end
5179 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5180 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5181 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5182 if (iabs(itype(i)).eq.20) then
5187 itori=itortyp(itype(i-2))
5188 itori1=itortyp(itype(i-1))
5191 C Regular cosine and sine terms
5192 do j=1,nterm(itori,itori1,iblock)
5193 v1ij=v1(j,itori,itori1,iblock)
5194 v2ij=v2(j,itori,itori1,iblock)
5197 etors=etors+v1ij*cosphi+v2ij*sinphi
5198 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5202 C E = SUM ----------------------------------- - v1
5203 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5205 cosphi=dcos(0.5d0*phii)
5206 sinphi=dsin(0.5d0*phii)
5207 do j=1,nlor(itori,itori1,iblock)
5208 vl1ij=vlor1(j,itori,itori1)
5209 vl2ij=vlor2(j,itori,itori1)
5210 vl3ij=vlor3(j,itori,itori1)
5211 pom=vl2ij*cosphi+vl3ij*sinphi
5212 pom1=1.0d0/(pom*pom+1.0d0)
5213 etors=etors+vl1ij*pom1
5215 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5217 C Subtract the constant term
5218 etors=etors-v0(itori,itori1,iblock)
5220 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5221 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5222 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5223 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5224 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5227 ! 6/20/98 - dihedral angle constraints
5230 itori=idih_constr(i)
5232 difi=pinorm(phii-phi0(i))
5234 if (difi.gt.drange(i)) then
5236 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5237 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5238 edihi=0.25d0*ftors(i)*difi**4
5239 else if (difi.lt.-drange(i)) then
5241 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5242 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5243 edihi=0.25d0*ftors(i)*difi**4
5247 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5249 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5250 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5252 ! write (iout,*) 'edihcnstr',edihcnstr
5255 c----------------------------------------------------------------------------
5256 subroutine etor_d(etors_d,fact2)
5257 C 6/23/01 Compute double torsional energy
5258 implicit real*8 (a-h,o-z)
5259 include 'DIMENSIONS'
5260 include 'sizesclu.dat'
5261 include 'COMMON.VAR'
5262 include 'COMMON.GEO'
5263 include 'COMMON.LOCAL'
5264 include 'COMMON.TORSION'
5265 include 'COMMON.INTERACT'
5266 include 'COMMON.DERIV'
5267 include 'COMMON.CHAIN'
5268 include 'COMMON.NAMES'
5269 include 'COMMON.IOUNITS'
5270 include 'COMMON.FFIELD'
5271 include 'COMMON.TORCNSTR'
5273 C Set lprn=.true. for debugging
5277 do i=iphi_start,iphi_end-1
5279 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5280 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5281 & (itype(i+1).eq.ntyp1)) cycle
5282 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5284 itori=itortyp(itype(i-2))
5285 itori1=itortyp(itype(i-1))
5286 itori2=itortyp(itype(i))
5292 if (iabs(itype(i+1)).eq.20) iblock=2
5293 C Regular cosine and sine terms
5294 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5295 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5296 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5297 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5298 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5299 cosphi1=dcos(j*phii)
5300 sinphi1=dsin(j*phii)
5301 cosphi2=dcos(j*phii1)
5302 sinphi2=dsin(j*phii1)
5303 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5304 & v2cij*cosphi2+v2sij*sinphi2
5305 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5306 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5308 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5310 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5311 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5312 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5313 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5314 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5315 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5316 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5317 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5318 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5319 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5320 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5321 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5322 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5323 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5326 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5327 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5333 c------------------------------------------------------------------------------
5334 subroutine eback_sc_corr(esccor)
5335 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5336 c conformational states; temporarily implemented as differences
5337 c between UNRES torsional potentials (dependent on three types of
5338 c residues) and the torsional potentials dependent on all 20 types
5339 c of residues computed from AM1 energy surfaces of terminally-blocked
5340 c amino-acid residues.
5341 implicit real*8 (a-h,o-z)
5342 include 'DIMENSIONS'
5343 include 'sizesclu.dat'
5344 include 'COMMON.VAR'
5345 include 'COMMON.GEO'
5346 include 'COMMON.LOCAL'
5347 include 'COMMON.TORSION'
5348 include 'COMMON.SCCOR'
5349 include 'COMMON.INTERACT'
5350 include 'COMMON.DERIV'
5351 include 'COMMON.CHAIN'
5352 include 'COMMON.NAMES'
5353 include 'COMMON.IOUNITS'
5354 include 'COMMON.FFIELD'
5355 include 'COMMON.CONTROL'
5357 C Set lprn=.true. for debugging
5360 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5362 do i=itau_start,itau_end
5363 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5365 isccori=isccortyp(itype(i-2))
5366 isccori1=isccortyp(itype(i-1))
5368 do intertyp=1,3 !intertyp
5369 cc Added 09 May 2012 (Adasko)
5370 cc Intertyp means interaction type of backbone mainchain correlation:
5371 c 1 = SC...Ca...Ca...Ca
5372 c 2 = Ca...Ca...Ca...SC
5373 c 3 = SC...Ca...Ca...SCi
5375 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5376 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5377 & (itype(i-1).eq.ntyp1)))
5378 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5379 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5380 & .or.(itype(i).eq.ntyp1)))
5381 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5382 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5383 & (itype(i-3).eq.ntyp1)))) cycle
5384 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5385 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5387 do j=1,nterm_sccor(isccori,isccori1)
5388 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5389 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5390 cosphi=dcos(j*tauangle(intertyp,i))
5391 sinphi=dsin(j*tauangle(intertyp,i))
5392 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5393 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5395 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
5396 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
5398 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5399 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5400 & (v1sccor(j,1,itori,itori1),j=1,6),
5401 & (v2sccor(j,1,itori,itori1),j=1,6)
5402 gsccor_loc(i-3)=gloci
5407 c------------------------------------------------------------------------------
5408 subroutine multibody(ecorr)
5409 C This subroutine calculates multi-body contributions to energy following
5410 C the idea of Skolnick et al. If side chains I and J make a contact and
5411 C at the same time side chains I+1 and J+1 make a contact, an extra
5412 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5413 implicit real*8 (a-h,o-z)
5414 include 'DIMENSIONS'
5415 include 'COMMON.IOUNITS'
5416 include 'COMMON.DERIV'
5417 include 'COMMON.INTERACT'
5418 include 'COMMON.CONTACTS'
5419 double precision gx(3),gx1(3)
5422 C Set lprn=.true. for debugging
5426 write (iout,'(a)') 'Contact function values:'
5428 write (iout,'(i2,20(1x,i2,f10.5))')
5429 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5444 num_conti=num_cont(i)
5445 num_conti1=num_cont(i1)
5450 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5451 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5452 cd & ' ishift=',ishift
5453 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5454 C The system gains extra energy.
5455 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5456 endif ! j1==j+-ishift
5465 c------------------------------------------------------------------------------
5466 double precision function esccorr(i,j,k,l,jj,kk)
5467 implicit real*8 (a-h,o-z)
5468 include 'DIMENSIONS'
5469 include 'COMMON.IOUNITS'
5470 include 'COMMON.DERIV'
5471 include 'COMMON.INTERACT'
5472 include 'COMMON.CONTACTS'
5473 double precision gx(3),gx1(3)
5478 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5479 C Calculate the multi-body contribution to energy.
5480 C Calculate multi-body contributions to the gradient.
5481 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5482 cd & k,l,(gacont(m,kk,k),m=1,3)
5484 gx(m) =ekl*gacont(m,jj,i)
5485 gx1(m)=eij*gacont(m,kk,k)
5486 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5487 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5488 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5489 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5493 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5498 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5504 c------------------------------------------------------------------------------
5506 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5507 implicit real*8 (a-h,o-z)
5508 include 'DIMENSIONS'
5509 integer dimen1,dimen2,atom,indx
5510 double precision buffer(dimen1,dimen2)
5511 double precision zapas
5512 common /contacts_hb/ zapas(3,20,maxres,7),
5513 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5514 & num_cont_hb(maxres),jcont_hb(20,maxres)
5515 num_kont=num_cont_hb(atom)
5519 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5522 buffer(i,indx+22)=facont_hb(i,atom)
5523 buffer(i,indx+23)=ees0p(i,atom)
5524 buffer(i,indx+24)=ees0m(i,atom)
5525 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5527 buffer(1,indx+26)=dfloat(num_kont)
5530 c------------------------------------------------------------------------------
5531 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5532 implicit real*8 (a-h,o-z)
5533 include 'DIMENSIONS'
5534 integer dimen1,dimen2,atom,indx
5535 double precision buffer(dimen1,dimen2)
5536 double precision zapas
5537 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5538 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5539 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5540 num_kont=buffer(1,indx+26)
5541 num_kont_old=num_cont_hb(atom)
5542 num_cont_hb(atom)=num_kont+num_kont_old
5547 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5550 facont_hb(ii,atom)=buffer(i,indx+22)
5551 ees0p(ii,atom)=buffer(i,indx+23)
5552 ees0m(ii,atom)=buffer(i,indx+24)
5553 jcont_hb(ii,atom)=buffer(i,indx+25)
5557 c------------------------------------------------------------------------------
5559 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5560 C This subroutine calculates multi-body contributions to hydrogen-bonding
5561 implicit real*8 (a-h,o-z)
5562 include 'DIMENSIONS'
5563 include 'sizesclu.dat'
5564 include 'COMMON.IOUNITS'
5566 include 'COMMON.INFO'
5568 include 'COMMON.FFIELD'
5569 include 'COMMON.DERIV'
5570 include 'COMMON.INTERACT'
5571 include 'COMMON.CONTACTS'
5573 parameter (max_cont=maxconts)
5574 parameter (max_dim=2*(8*3+2))
5575 parameter (msglen1=max_cont*max_dim*4)
5576 parameter (msglen2=2*msglen1)
5577 integer source,CorrelType,CorrelID,Error
5578 double precision buffer(max_cont,max_dim)
5580 double precision gx(3),gx1(3)
5583 C Set lprn=.true. for debugging
5588 if (fgProcs.le.1) goto 30
5590 write (iout,'(a)') 'Contact function values:'
5592 write (iout,'(2i3,50(1x,i2,f5.2))')
5593 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5594 & j=1,num_cont_hb(i))
5597 C Caution! Following code assumes that electrostatic interactions concerning
5598 C a given atom are split among at most two processors!
5608 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5611 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5612 if (MyRank.gt.0) then
5613 C Send correlation contributions to the preceding processor
5615 nn=num_cont_hb(iatel_s)
5616 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5617 cd write (iout,*) 'The BUFFER array:'
5619 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5621 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5623 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5624 C Clear the contacts of the atom passed to the neighboring processor
5625 nn=num_cont_hb(iatel_s+1)
5627 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5629 num_cont_hb(iatel_s)=0
5631 cd write (iout,*) 'Processor ',MyID,MyRank,
5632 cd & ' is sending correlation contribution to processor',MyID-1,
5633 cd & ' msglen=',msglen
5634 cd write (*,*) 'Processor ',MyID,MyRank,
5635 cd & ' is sending correlation contribution to processor',MyID-1,
5636 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5637 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5638 cd write (iout,*) 'Processor ',MyID,
5639 cd & ' has sent correlation contribution to processor',MyID-1,
5640 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5641 cd write (*,*) 'Processor ',MyID,
5642 cd & ' has sent correlation contribution to processor',MyID-1,
5643 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5645 endif ! (MyRank.gt.0)
5649 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5650 if (MyRank.lt.fgProcs-1) then
5651 C Receive correlation contributions from the next processor
5653 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5654 cd write (iout,*) 'Processor',MyID,
5655 cd & ' is receiving correlation contribution from processor',MyID+1,
5656 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5657 cd write (*,*) 'Processor',MyID,
5658 cd & ' is receiving correlation contribution from processor',MyID+1,
5659 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5661 do while (nbytes.le.0)
5662 call mp_probe(MyID+1,CorrelType,nbytes)
5664 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5665 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5666 cd write (iout,*) 'Processor',MyID,
5667 cd & ' has received correlation contribution from processor',MyID+1,
5668 cd & ' msglen=',msglen,' nbytes=',nbytes
5669 cd write (iout,*) 'The received BUFFER array:'
5671 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5673 if (msglen.eq.msglen1) then
5674 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5675 else if (msglen.eq.msglen2) then
5676 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5677 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5680 & 'ERROR!!!! message length changed while processing correlations.'
5682 & 'ERROR!!!! message length changed while processing correlations.'
5683 call mp_stopall(Error)
5684 endif ! msglen.eq.msglen1
5685 endif ! MyRank.lt.fgProcs-1
5692 write (iout,'(a)') 'Contact function values:'
5694 write (iout,'(2i3,50(1x,i2,f5.2))')
5695 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5696 & j=1,num_cont_hb(i))
5700 C Remove the loop below after debugging !!!
5707 C Calculate the local-electrostatic correlation terms
5708 do i=iatel_s,iatel_e+1
5710 num_conti=num_cont_hb(i)
5711 num_conti1=num_cont_hb(i+1)
5716 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5717 c & ' jj=',jj,' kk=',kk
5718 if (j1.eq.j+1 .or. j1.eq.j-1) then
5719 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5720 C The system gains extra energy.
5721 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5723 else if (j1.eq.j) then
5724 C Contacts I-J and I-(J+1) occur simultaneously.
5725 C The system loses extra energy.
5726 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5731 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5732 c & ' jj=',jj,' kk=',kk
5734 C Contacts I-J and (I+1)-J occur simultaneously.
5735 C The system loses extra energy.
5736 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5743 c------------------------------------------------------------------------------
5744 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5746 C This subroutine calculates multi-body contributions to hydrogen-bonding
5747 implicit real*8 (a-h,o-z)
5748 include 'DIMENSIONS'
5749 include 'sizesclu.dat'
5750 include 'COMMON.IOUNITS'
5752 include 'COMMON.INFO'
5754 include 'COMMON.FFIELD'
5755 include 'COMMON.DERIV'
5756 include 'COMMON.INTERACT'
5757 include 'COMMON.CONTACTS'
5759 parameter (max_cont=maxconts)
5760 parameter (max_dim=2*(8*3+2))
5761 parameter (msglen1=max_cont*max_dim*4)
5762 parameter (msglen2=2*msglen1)
5763 integer source,CorrelType,CorrelID,Error
5764 double precision buffer(max_cont,max_dim)
5766 double precision gx(3),gx1(3)
5769 C Set lprn=.true. for debugging
5775 if (fgProcs.le.1) goto 30
5777 write (iout,'(a)') 'Contact function values:'
5779 write (iout,'(2i3,50(1x,i2,f5.2))')
5780 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5781 & j=1,num_cont_hb(i))
5784 C Caution! Following code assumes that electrostatic interactions concerning
5785 C a given atom are split among at most two processors!
5795 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5798 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5799 if (MyRank.gt.0) then
5800 C Send correlation contributions to the preceding processor
5802 nn=num_cont_hb(iatel_s)
5803 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5804 cd write (iout,*) 'The BUFFER array:'
5806 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5808 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5810 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5811 C Clear the contacts of the atom passed to the neighboring processor
5812 nn=num_cont_hb(iatel_s+1)
5814 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5816 num_cont_hb(iatel_s)=0
5818 cd write (iout,*) 'Processor ',MyID,MyRank,
5819 cd & ' is sending correlation contribution to processor',MyID-1,
5820 cd & ' msglen=',msglen
5821 cd write (*,*) 'Processor ',MyID,MyRank,
5822 cd & ' is sending correlation contribution to processor',MyID-1,
5823 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5824 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5825 cd write (iout,*) 'Processor ',MyID,
5826 cd & ' has sent correlation contribution to processor',MyID-1,
5827 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5828 cd write (*,*) 'Processor ',MyID,
5829 cd & ' has sent correlation contribution to processor',MyID-1,
5830 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5832 endif ! (MyRank.gt.0)
5836 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5837 if (MyRank.lt.fgProcs-1) then
5838 C Receive correlation contributions from the next processor
5840 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5841 cd write (iout,*) 'Processor',MyID,
5842 cd & ' is receiving correlation contribution from processor',MyID+1,
5843 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5844 cd write (*,*) 'Processor',MyID,
5845 cd & ' is receiving correlation contribution from processor',MyID+1,
5846 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5848 do while (nbytes.le.0)
5849 call mp_probe(MyID+1,CorrelType,nbytes)
5851 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5852 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5853 cd write (iout,*) 'Processor',MyID,
5854 cd & ' has received correlation contribution from processor',MyID+1,
5855 cd & ' msglen=',msglen,' nbytes=',nbytes
5856 cd write (iout,*) 'The received BUFFER array:'
5858 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5860 if (msglen.eq.msglen1) then
5861 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5862 else if (msglen.eq.msglen2) then
5863 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5864 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5867 & 'ERROR!!!! message length changed while processing correlations.'
5869 & 'ERROR!!!! message length changed while processing correlations.'
5870 call mp_stopall(Error)
5871 endif ! msglen.eq.msglen1
5872 endif ! MyRank.lt.fgProcs-1
5879 write (iout,'(a)') 'Contact function values:'
5881 write (iout,'(2i3,50(1x,i2,f5.2))')
5882 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5883 & j=1,num_cont_hb(i))
5889 C Remove the loop below after debugging !!!
5896 C Calculate the dipole-dipole interaction energies
5897 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5898 do i=iatel_s,iatel_e+1
5899 num_conti=num_cont_hb(i)
5906 C Calculate the local-electrostatic correlation terms
5907 do i=iatel_s,iatel_e+1
5909 num_conti=num_cont_hb(i)
5910 num_conti1=num_cont_hb(i+1)
5915 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5916 c & ' jj=',jj,' kk=',kk
5917 if (j1.eq.j+1 .or. j1.eq.j-1) then
5918 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5919 C The system gains extra energy.
5921 sqd1=dsqrt(d_cont(jj,i))
5922 sqd2=dsqrt(d_cont(kk,i1))
5923 sred_geom = sqd1*sqd2
5924 IF (sred_geom.lt.cutoff_corr) THEN
5925 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5927 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5928 c & ' jj=',jj,' kk=',kk
5929 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5930 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5932 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5933 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5936 cd write (iout,*) 'sred_geom=',sred_geom,
5937 cd & ' ekont=',ekont,' fprim=',fprimcont
5938 call calc_eello(i,j,i+1,j1,jj,kk)
5939 if (wcorr4.gt.0.0d0)
5940 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5941 if (wcorr5.gt.0.0d0)
5942 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5943 c print *,"wcorr5",ecorr5
5944 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5945 cd write(2,*)'ijkl',i,j,i+1,j1
5946 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5947 & .or. wturn6.eq.0.0d0))then
5948 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5949 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5950 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5951 cd & 'ecorr6=',ecorr6
5952 cd write (iout,'(4e15.5)') sred_geom,
5953 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5954 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5955 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5956 else if (wturn6.gt.0.0d0
5957 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5958 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5959 eturn6=eturn6+eello_turn6(i,jj,kk)
5960 cd write (2,*) 'multibody_eello:eturn6',eturn6
5964 else if (j1.eq.j) then
5965 C Contacts I-J and I-(J+1) occur simultaneously.
5966 C The system loses extra energy.
5967 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5972 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5973 c & ' jj=',jj,' kk=',kk
5975 C Contacts I-J and (I+1)-J occur simultaneously.
5976 C The system loses extra energy.
5977 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5984 c------------------------------------------------------------------------------
5985 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5986 implicit real*8 (a-h,o-z)
5987 include 'DIMENSIONS'
5988 include 'COMMON.IOUNITS'
5989 include 'COMMON.DERIV'
5990 include 'COMMON.INTERACT'
5991 include 'COMMON.CONTACTS'
5992 include 'COMMON.SHIELD'
5994 double precision gx(3),gx1(3)
6004 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6005 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6006 C Following 4 lines for diagnostics.
6011 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6013 c write (iout,*)'Contacts have occurred for peptide groups',
6014 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6015 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6016 C Calculate the multi-body contribution to energy.
6017 ecorr=ecorr+ekont*ees
6019 C Calculate multi-body contributions to the gradient.
6021 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6022 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6023 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6024 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6025 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6026 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6027 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6028 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6029 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6030 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6031 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6032 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6033 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6034 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6038 gradcorr(ll,m)=gradcorr(ll,m)+
6039 & ees*ekl*gacont_hbr(ll,jj,i)-
6040 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6041 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6046 gradcorr(ll,m)=gradcorr(ll,m)+
6047 & ees*eij*gacont_hbr(ll,kk,k)-
6048 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6049 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6052 if (shield_mode.gt.0) then
6055 C print *,i,j,fac_shield(i),fac_shield(j),
6056 C &fac_shield(k),fac_shield(l)
6057 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6058 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6059 do ilist=1,ishield_list(i)
6060 iresshield=shield_list(ilist,i)
6062 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6064 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6066 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6067 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6071 do ilist=1,ishield_list(j)
6072 iresshield=shield_list(ilist,j)
6074 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6076 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6078 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6079 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6083 do ilist=1,ishield_list(k)
6084 iresshield=shield_list(ilist,k)
6086 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6088 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6090 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6091 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6095 do ilist=1,ishield_list(l)
6096 iresshield=shield_list(ilist,l)
6098 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6100 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6102 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6103 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6107 C print *,gshieldx(m,iresshield)
6109 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6110 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6111 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6112 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6113 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6114 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6115 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6116 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6118 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6119 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6120 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6121 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6122 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6123 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6124 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6125 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6134 C---------------------------------------------------------------------------
6135 subroutine dipole(i,j,jj)
6136 implicit real*8 (a-h,o-z)
6137 include 'DIMENSIONS'
6138 include 'sizesclu.dat'
6139 include 'COMMON.IOUNITS'
6140 include 'COMMON.CHAIN'
6141 include 'COMMON.FFIELD'
6142 include 'COMMON.DERIV'
6143 include 'COMMON.INTERACT'
6144 include 'COMMON.CONTACTS'
6145 include 'COMMON.TORSION'
6146 include 'COMMON.VAR'
6147 include 'COMMON.GEO'
6148 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6150 iti1 = itortyp(itype(i+1))
6151 if (j.lt.nres-1) then
6152 if (itype(j).le.ntyp) then
6153 itj1 = itortyp(itype(j+1))
6161 dipi(iii,1)=Ub2(iii,i)
6162 dipderi(iii)=Ub2der(iii,i)
6163 dipi(iii,2)=b1(iii,iti1)
6164 dipj(iii,1)=Ub2(iii,j)
6165 dipderj(iii)=Ub2der(iii,j)
6166 dipj(iii,2)=b1(iii,itj1)
6170 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6173 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6176 if (.not.calc_grad) return
6181 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6185 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6190 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6191 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6193 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6195 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6197 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6201 C---------------------------------------------------------------------------
6202 subroutine calc_eello(i,j,k,l,jj,kk)
6204 C This subroutine computes matrices and vectors needed to calculate
6205 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6207 implicit real*8 (a-h,o-z)
6208 include 'DIMENSIONS'
6209 include 'sizesclu.dat'
6210 include 'COMMON.IOUNITS'
6211 include 'COMMON.CHAIN'
6212 include 'COMMON.DERIV'
6213 include 'COMMON.INTERACT'
6214 include 'COMMON.CONTACTS'
6215 include 'COMMON.TORSION'
6216 include 'COMMON.VAR'
6217 include 'COMMON.GEO'
6218 include 'COMMON.FFIELD'
6219 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6220 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6223 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6224 cd & ' jj=',jj,' kk=',kk
6225 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6228 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6229 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6232 call transpose2(aa1(1,1),aa1t(1,1))
6233 call transpose2(aa2(1,1),aa2t(1,1))
6236 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6237 & aa1tder(1,1,lll,kkk))
6238 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6239 & aa2tder(1,1,lll,kkk))
6243 C parallel orientation of the two CA-CA-CA frames.
6245 if (i.gt.1 .and. itype(i).le.ntyp) then
6246 iti=itortyp(itype(i))
6250 itk1=itortyp(itype(k+1))
6251 itj=itortyp(itype(j))
6252 c if (l.lt.nres-1) then
6253 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6254 itl1=itortyp(itype(l+1))
6258 C A1 kernel(j+1) A2T
6260 cd write (iout,'(3f10.5,5x,3f10.5)')
6261 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6263 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6264 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6265 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6266 C Following matrices are needed only for 6-th order cumulants
6267 IF (wcorr6.gt.0.0d0) THEN
6268 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6269 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6270 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6271 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6272 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6273 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6274 & ADtEAderx(1,1,1,1,1,1))
6276 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6277 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6278 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6279 & ADtEA1derx(1,1,1,1,1,1))
6281 C End 6-th order cumulants
6284 cd write (2,*) 'In calc_eello6'
6286 cd write (2,*) 'iii=',iii
6288 cd write (2,*) 'kkk=',kkk
6290 cd write (2,'(3(2f10.5),5x)')
6291 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6296 call transpose2(EUgder(1,1,k),auxmat(1,1))
6297 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6298 call transpose2(EUg(1,1,k),auxmat(1,1))
6299 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6300 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6304 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6305 & EAEAderx(1,1,lll,kkk,iii,1))
6309 C A1T kernel(i+1) A2
6310 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6311 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6312 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6313 C Following matrices are needed only for 6-th order cumulants
6314 IF (wcorr6.gt.0.0d0) THEN
6315 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6316 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6317 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6318 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6319 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6320 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6321 & ADtEAderx(1,1,1,1,1,2))
6322 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6323 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6324 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6325 & ADtEA1derx(1,1,1,1,1,2))
6327 C End 6-th order cumulants
6328 call transpose2(EUgder(1,1,l),auxmat(1,1))
6329 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6330 call transpose2(EUg(1,1,l),auxmat(1,1))
6331 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6332 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6336 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6337 & EAEAderx(1,1,lll,kkk,iii,2))
6342 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6343 C They are needed only when the fifth- or the sixth-order cumulants are
6345 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6346 call transpose2(AEA(1,1,1),auxmat(1,1))
6347 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6348 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6349 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6350 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6351 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6352 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6353 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6354 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6355 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6356 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6357 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6358 call transpose2(AEA(1,1,2),auxmat(1,1))
6359 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6360 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6361 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6362 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6363 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6364 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6365 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6366 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6367 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6368 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6369 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6370 C Calculate the Cartesian derivatives of the vectors.
6374 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6375 call matvec2(auxmat(1,1),b1(1,iti),
6376 & AEAb1derx(1,lll,kkk,iii,1,1))
6377 call matvec2(auxmat(1,1),Ub2(1,i),
6378 & AEAb2derx(1,lll,kkk,iii,1,1))
6379 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6380 & AEAb1derx(1,lll,kkk,iii,2,1))
6381 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6382 & AEAb2derx(1,lll,kkk,iii,2,1))
6383 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6384 call matvec2(auxmat(1,1),b1(1,itj),
6385 & AEAb1derx(1,lll,kkk,iii,1,2))
6386 call matvec2(auxmat(1,1),Ub2(1,j),
6387 & AEAb2derx(1,lll,kkk,iii,1,2))
6388 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6389 & AEAb1derx(1,lll,kkk,iii,2,2))
6390 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6391 & AEAb2derx(1,lll,kkk,iii,2,2))
6398 C Antiparallel orientation of the two CA-CA-CA frames.
6400 if (i.gt.1 .and. itype(i).le.ntyp) then
6401 iti=itortyp(itype(i))
6405 itk1=itortyp(itype(k+1))
6406 itl=itortyp(itype(l))
6407 itj=itortyp(itype(j))
6408 c if (j.lt.nres-1) then
6409 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6410 itj1=itortyp(itype(j+1))
6414 C A2 kernel(j-1)T A1T
6415 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6416 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6417 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6418 C Following matrices are needed only for 6-th order cumulants
6419 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6420 & j.eq.i+4 .and. l.eq.i+3)) THEN
6421 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6422 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6423 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6424 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6425 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6426 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6427 & ADtEAderx(1,1,1,1,1,1))
6428 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6429 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6430 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6431 & ADtEA1derx(1,1,1,1,1,1))
6433 C End 6-th order cumulants
6434 call transpose2(EUgder(1,1,k),auxmat(1,1))
6435 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6436 call transpose2(EUg(1,1,k),auxmat(1,1))
6437 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6438 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6442 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6443 & EAEAderx(1,1,lll,kkk,iii,1))
6447 C A2T kernel(i+1)T A1
6448 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6449 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6450 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6451 C Following matrices are needed only for 6-th order cumulants
6452 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6453 & j.eq.i+4 .and. l.eq.i+3)) THEN
6454 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6455 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6456 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6457 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6458 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6459 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6460 & ADtEAderx(1,1,1,1,1,2))
6461 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6462 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6463 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6464 & ADtEA1derx(1,1,1,1,1,2))
6466 C End 6-th order cumulants
6467 call transpose2(EUgder(1,1,j),auxmat(1,1))
6468 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6469 call transpose2(EUg(1,1,j),auxmat(1,1))
6470 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6471 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6475 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6476 & EAEAderx(1,1,lll,kkk,iii,2))
6481 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6482 C They are needed only when the fifth- or the sixth-order cumulants are
6484 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6485 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6486 call transpose2(AEA(1,1,1),auxmat(1,1))
6487 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6488 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6489 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6490 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6491 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6492 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6493 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6494 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6495 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6496 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6497 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6498 call transpose2(AEA(1,1,2),auxmat(1,1))
6499 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6500 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6501 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6502 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6503 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6504 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6505 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6506 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6507 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6508 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6509 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6510 C Calculate the Cartesian derivatives of the vectors.
6514 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6515 call matvec2(auxmat(1,1),b1(1,iti),
6516 & AEAb1derx(1,lll,kkk,iii,1,1))
6517 call matvec2(auxmat(1,1),Ub2(1,i),
6518 & AEAb2derx(1,lll,kkk,iii,1,1))
6519 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6520 & AEAb1derx(1,lll,kkk,iii,2,1))
6521 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6522 & AEAb2derx(1,lll,kkk,iii,2,1))
6523 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6524 call matvec2(auxmat(1,1),b1(1,itl),
6525 & AEAb1derx(1,lll,kkk,iii,1,2))
6526 call matvec2(auxmat(1,1),Ub2(1,l),
6527 & AEAb2derx(1,lll,kkk,iii,1,2))
6528 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6529 & AEAb1derx(1,lll,kkk,iii,2,2))
6530 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6531 & AEAb2derx(1,lll,kkk,iii,2,2))
6540 C---------------------------------------------------------------------------
6541 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6542 & KK,KKderg,AKA,AKAderg,AKAderx)
6546 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6547 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6548 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6553 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6555 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6558 cd if (lprn) write (2,*) 'In kernel'
6560 cd if (lprn) write (2,*) 'kkk=',kkk
6562 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6563 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6565 cd write (2,*) 'lll=',lll
6566 cd write (2,*) 'iii=1'
6568 cd write (2,'(3(2f10.5),5x)')
6569 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6572 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6573 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6575 cd write (2,*) 'lll=',lll
6576 cd write (2,*) 'iii=2'
6578 cd write (2,'(3(2f10.5),5x)')
6579 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6586 C---------------------------------------------------------------------------
6587 double precision function eello4(i,j,k,l,jj,kk)
6588 implicit real*8 (a-h,o-z)
6589 include 'DIMENSIONS'
6590 include 'sizesclu.dat'
6591 include 'COMMON.IOUNITS'
6592 include 'COMMON.CHAIN'
6593 include 'COMMON.DERIV'
6594 include 'COMMON.INTERACT'
6595 include 'COMMON.CONTACTS'
6596 include 'COMMON.TORSION'
6597 include 'COMMON.VAR'
6598 include 'COMMON.GEO'
6599 double precision pizda(2,2),ggg1(3),ggg2(3)
6600 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6604 cd print *,'eello4:',i,j,k,l,jj,kk
6605 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6606 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6607 cold eij=facont_hb(jj,i)
6608 cold ekl=facont_hb(kk,k)
6610 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6612 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6613 gcorr_loc(k-1)=gcorr_loc(k-1)
6614 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6616 gcorr_loc(l-1)=gcorr_loc(l-1)
6617 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6619 gcorr_loc(j-1)=gcorr_loc(j-1)
6620 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6625 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6626 & -EAEAderx(2,2,lll,kkk,iii,1)
6627 cd derx(lll,kkk,iii)=0.0d0
6631 cd gcorr_loc(l-1)=0.0d0
6632 cd gcorr_loc(j-1)=0.0d0
6633 cd gcorr_loc(k-1)=0.0d0
6635 cd write (iout,*)'Contacts have occurred for peptide groups',
6636 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6637 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6638 if (j.lt.nres-1) then
6645 if (l.lt.nres-1) then
6653 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6654 ggg1(ll)=eel4*g_contij(ll,1)
6655 ggg2(ll)=eel4*g_contij(ll,2)
6656 ghalf=0.5d0*ggg1(ll)
6658 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6659 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6660 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6661 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6662 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6663 ghalf=0.5d0*ggg2(ll)
6665 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6666 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6667 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6668 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6673 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6674 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6679 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6680 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6686 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6691 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6695 cd write (2,*) iii,gcorr_loc(iii)
6699 cd write (2,*) 'ekont',ekont
6700 cd write (iout,*) 'eello4',ekont*eel4
6703 C---------------------------------------------------------------------------
6704 double precision function eello5(i,j,k,l,jj,kk)
6705 implicit real*8 (a-h,o-z)
6706 include 'DIMENSIONS'
6707 include 'sizesclu.dat'
6708 include 'COMMON.IOUNITS'
6709 include 'COMMON.CHAIN'
6710 include 'COMMON.DERIV'
6711 include 'COMMON.INTERACT'
6712 include 'COMMON.CONTACTS'
6713 include 'COMMON.TORSION'
6714 include 'COMMON.VAR'
6715 include 'COMMON.GEO'
6716 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6717 double precision ggg1(3),ggg2(3)
6718 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6723 C /l\ / \ \ / \ / \ / C
6724 C / \ / \ \ / \ / \ / C
6725 C j| o |l1 | o | o| o | | o |o C
6726 C \ |/k\| |/ \| / |/ \| |/ \| C
6727 C \i/ \ / \ / / \ / \ C
6729 C (I) (II) (III) (IV) C
6731 C eello5_1 eello5_2 eello5_3 eello5_4 C
6733 C Antiparallel chains C
6736 C /j\ / \ \ / \ / \ / C
6737 C / \ / \ \ / \ / \ / C
6738 C j1| o |l | o | o| o | | o |o C
6739 C \ |/k\| |/ \| / |/ \| |/ \| C
6740 C \i/ \ / \ / / \ / \ C
6742 C (I) (II) (III) (IV) C
6744 C eello5_1 eello5_2 eello5_3 eello5_4 C
6746 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6748 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6749 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6754 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6756 itk=itortyp(itype(k))
6757 itl=itortyp(itype(l))
6758 itj=itortyp(itype(j))
6763 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6764 cd & eel5_3_num,eel5_4_num)
6768 derx(lll,kkk,iii)=0.0d0
6772 cd eij=facont_hb(jj,i)
6773 cd ekl=facont_hb(kk,k)
6775 cd write (iout,*)'Contacts have occurred for peptide groups',
6776 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6778 C Contribution from the graph I.
6779 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6780 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6781 call transpose2(EUg(1,1,k),auxmat(1,1))
6782 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6783 vv(1)=pizda(1,1)-pizda(2,2)
6784 vv(2)=pizda(1,2)+pizda(2,1)
6785 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6786 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6788 C Explicit gradient in virtual-dihedral angles.
6789 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6790 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6791 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6792 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6793 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6794 vv(1)=pizda(1,1)-pizda(2,2)
6795 vv(2)=pizda(1,2)+pizda(2,1)
6796 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6797 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6798 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6799 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6800 vv(1)=pizda(1,1)-pizda(2,2)
6801 vv(2)=pizda(1,2)+pizda(2,1)
6803 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6804 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6805 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6807 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6808 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6809 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6811 C Cartesian gradient
6815 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6817 vv(1)=pizda(1,1)-pizda(2,2)
6818 vv(2)=pizda(1,2)+pizda(2,1)
6819 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6820 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6821 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6828 C Contribution from graph II
6829 call transpose2(EE(1,1,itk),auxmat(1,1))
6830 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6831 vv(1)=pizda(1,1)+pizda(2,2)
6832 vv(2)=pizda(2,1)-pizda(1,2)
6833 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6834 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6836 C Explicit gradient in virtual-dihedral angles.
6837 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6838 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6839 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6840 vv(1)=pizda(1,1)+pizda(2,2)
6841 vv(2)=pizda(2,1)-pizda(1,2)
6843 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6844 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6845 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6847 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6848 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6849 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6851 C Cartesian gradient
6855 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6857 vv(1)=pizda(1,1)+pizda(2,2)
6858 vv(2)=pizda(2,1)-pizda(1,2)
6859 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6860 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6861 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6870 C Parallel orientation
6871 C Contribution from graph III
6872 call transpose2(EUg(1,1,l),auxmat(1,1))
6873 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6874 vv(1)=pizda(1,1)-pizda(2,2)
6875 vv(2)=pizda(1,2)+pizda(2,1)
6876 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6877 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6879 C Explicit gradient in virtual-dihedral angles.
6880 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6881 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6882 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6883 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6884 vv(1)=pizda(1,1)-pizda(2,2)
6885 vv(2)=pizda(1,2)+pizda(2,1)
6886 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6887 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6888 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6889 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6890 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6891 vv(1)=pizda(1,1)-pizda(2,2)
6892 vv(2)=pizda(1,2)+pizda(2,1)
6893 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6894 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6895 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6896 C Cartesian gradient
6900 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6902 vv(1)=pizda(1,1)-pizda(2,2)
6903 vv(2)=pizda(1,2)+pizda(2,1)
6904 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6905 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6906 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6912 C Contribution from graph IV
6914 call transpose2(EE(1,1,itl),auxmat(1,1))
6915 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6916 vv(1)=pizda(1,1)+pizda(2,2)
6917 vv(2)=pizda(2,1)-pizda(1,2)
6918 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6919 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6921 C Explicit gradient in virtual-dihedral angles.
6922 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6923 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6924 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6925 vv(1)=pizda(1,1)+pizda(2,2)
6926 vv(2)=pizda(2,1)-pizda(1,2)
6927 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6928 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6929 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6930 C Cartesian gradient
6934 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6936 vv(1)=pizda(1,1)+pizda(2,2)
6937 vv(2)=pizda(2,1)-pizda(1,2)
6938 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6939 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6940 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6946 C Antiparallel orientation
6947 C Contribution from graph III
6949 call transpose2(EUg(1,1,j),auxmat(1,1))
6950 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6951 vv(1)=pizda(1,1)-pizda(2,2)
6952 vv(2)=pizda(1,2)+pizda(2,1)
6953 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6954 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6956 C Explicit gradient in virtual-dihedral angles.
6957 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6958 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6959 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6960 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6961 vv(1)=pizda(1,1)-pizda(2,2)
6962 vv(2)=pizda(1,2)+pizda(2,1)
6963 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6964 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6965 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6966 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6967 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6968 vv(1)=pizda(1,1)-pizda(2,2)
6969 vv(2)=pizda(1,2)+pizda(2,1)
6970 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6971 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6972 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6973 C Cartesian gradient
6977 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6979 vv(1)=pizda(1,1)-pizda(2,2)
6980 vv(2)=pizda(1,2)+pizda(2,1)
6981 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6982 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6983 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6989 C Contribution from graph IV
6991 call transpose2(EE(1,1,itj),auxmat(1,1))
6992 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6993 vv(1)=pizda(1,1)+pizda(2,2)
6994 vv(2)=pizda(2,1)-pizda(1,2)
6995 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6996 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6998 C Explicit gradient in virtual-dihedral angles.
6999 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7000 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7001 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7002 vv(1)=pizda(1,1)+pizda(2,2)
7003 vv(2)=pizda(2,1)-pizda(1,2)
7004 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7005 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7006 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7007 C Cartesian gradient
7011 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7013 vv(1)=pizda(1,1)+pizda(2,2)
7014 vv(2)=pizda(2,1)-pizda(1,2)
7015 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7016 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7017 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7024 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7025 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7026 cd write (2,*) 'ijkl',i,j,k,l
7027 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7028 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7030 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7031 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7032 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7033 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7035 if (j.lt.nres-1) then
7042 if (l.lt.nres-1) then
7052 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7054 ggg1(ll)=eel5*g_contij(ll,1)
7055 ggg2(ll)=eel5*g_contij(ll,2)
7056 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7057 ghalf=0.5d0*ggg1(ll)
7059 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7060 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7061 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7062 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7063 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7064 ghalf=0.5d0*ggg2(ll)
7066 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7067 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7068 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7069 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7074 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7075 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7080 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7081 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7087 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7092 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7096 cd write (2,*) iii,g_corr5_loc(iii)
7100 cd write (2,*) 'ekont',ekont
7101 cd write (iout,*) 'eello5',ekont*eel5
7104 c--------------------------------------------------------------------------
7105 double precision function eello6(i,j,k,l,jj,kk)
7106 implicit real*8 (a-h,o-z)
7107 include 'DIMENSIONS'
7108 include 'sizesclu.dat'
7109 include 'COMMON.IOUNITS'
7110 include 'COMMON.CHAIN'
7111 include 'COMMON.DERIV'
7112 include 'COMMON.INTERACT'
7113 include 'COMMON.CONTACTS'
7114 include 'COMMON.TORSION'
7115 include 'COMMON.VAR'
7116 include 'COMMON.GEO'
7117 include 'COMMON.FFIELD'
7118 double precision ggg1(3),ggg2(3)
7119 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7124 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7132 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7133 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7137 derx(lll,kkk,iii)=0.0d0
7141 cd eij=facont_hb(jj,i)
7142 cd ekl=facont_hb(kk,k)
7148 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7149 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7150 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7151 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7152 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7153 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7155 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7156 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7157 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7158 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7159 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7160 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7164 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7166 C If turn contributions are considered, they will be handled separately.
7167 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7168 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7169 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7170 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7171 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7172 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7173 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7176 if (j.lt.nres-1) then
7183 if (l.lt.nres-1) then
7191 ggg1(ll)=eel6*g_contij(ll,1)
7192 ggg2(ll)=eel6*g_contij(ll,2)
7193 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7194 ghalf=0.5d0*ggg1(ll)
7196 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7197 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7198 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7199 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7200 ghalf=0.5d0*ggg2(ll)
7201 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7203 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7204 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7205 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7206 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7211 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7212 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7217 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7218 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7224 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7229 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7233 cd write (2,*) iii,g_corr6_loc(iii)
7237 cd write (2,*) 'ekont',ekont
7238 cd write (iout,*) 'eello6',ekont*eel6
7241 c--------------------------------------------------------------------------
7242 double precision function eello6_graph1(i,j,k,l,imat,swap)
7243 implicit real*8 (a-h,o-z)
7244 include 'DIMENSIONS'
7245 include 'sizesclu.dat'
7246 include 'COMMON.IOUNITS'
7247 include 'COMMON.CHAIN'
7248 include 'COMMON.DERIV'
7249 include 'COMMON.INTERACT'
7250 include 'COMMON.CONTACTS'
7251 include 'COMMON.TORSION'
7252 include 'COMMON.VAR'
7253 include 'COMMON.GEO'
7254 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7258 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7260 C Parallel Antiparallel C
7266 C \ j|/k\| / \ |/k\|l / C
7271 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7272 itk=itortyp(itype(k))
7273 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7274 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7275 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7276 call transpose2(EUgC(1,1,k),auxmat(1,1))
7277 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7278 vv1(1)=pizda1(1,1)-pizda1(2,2)
7279 vv1(2)=pizda1(1,2)+pizda1(2,1)
7280 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7281 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7282 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7283 s5=scalar2(vv(1),Dtobr2(1,i))
7284 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7285 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7286 if (.not. calc_grad) return
7287 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7288 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7289 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7290 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7291 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7292 & +scalar2(vv(1),Dtobr2der(1,i)))
7293 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7294 vv1(1)=pizda1(1,1)-pizda1(2,2)
7295 vv1(2)=pizda1(1,2)+pizda1(2,1)
7296 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7297 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7299 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7300 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7301 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7302 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7303 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7305 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7306 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7307 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7308 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7309 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7311 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7312 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7313 vv1(1)=pizda1(1,1)-pizda1(2,2)
7314 vv1(2)=pizda1(1,2)+pizda1(2,1)
7315 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7316 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7317 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7318 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7327 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7328 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7329 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7330 call transpose2(EUgC(1,1,k),auxmat(1,1))
7331 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7333 vv1(1)=pizda1(1,1)-pizda1(2,2)
7334 vv1(2)=pizda1(1,2)+pizda1(2,1)
7335 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7336 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7337 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7338 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7339 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7340 s5=scalar2(vv(1),Dtobr2(1,i))
7341 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7347 c----------------------------------------------------------------------------
7348 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7349 implicit real*8 (a-h,o-z)
7350 include 'DIMENSIONS'
7351 include 'sizesclu.dat'
7352 include 'COMMON.IOUNITS'
7353 include 'COMMON.CHAIN'
7354 include 'COMMON.DERIV'
7355 include 'COMMON.INTERACT'
7356 include 'COMMON.CONTACTS'
7357 include 'COMMON.TORSION'
7358 include 'COMMON.VAR'
7359 include 'COMMON.GEO'
7361 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7362 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7365 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7367 C Parallel Antiparallel C
7373 C \ j|/k\| \ |/k\|l C
7378 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7379 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7380 C AL 7/4/01 s1 would occur in the sixth-order moment,
7381 C but not in a cluster cumulant
7383 s1=dip(1,jj,i)*dip(1,kk,k)
7385 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7386 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7387 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7388 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7389 call transpose2(EUg(1,1,k),auxmat(1,1))
7390 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7391 vv(1)=pizda(1,1)-pizda(2,2)
7392 vv(2)=pizda(1,2)+pizda(2,1)
7393 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7394 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7396 eello6_graph2=-(s1+s2+s3+s4)
7398 eello6_graph2=-(s2+s3+s4)
7401 if (.not. calc_grad) return
7402 C Derivatives in gamma(i-1)
7405 s1=dipderg(1,jj,i)*dip(1,kk,k)
7407 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7408 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7409 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7410 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7412 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7414 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7416 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7418 C Derivatives in gamma(k-1)
7420 s1=dip(1,jj,i)*dipderg(1,kk,k)
7422 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7423 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7424 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7425 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7426 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7427 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7428 vv(1)=pizda(1,1)-pizda(2,2)
7429 vv(2)=pizda(1,2)+pizda(2,1)
7430 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7432 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7434 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7436 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7437 C Derivatives in gamma(j-1) or gamma(l-1)
7440 s1=dipderg(3,jj,i)*dip(1,kk,k)
7442 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7443 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7444 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7445 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7446 vv(1)=pizda(1,1)-pizda(2,2)
7447 vv(2)=pizda(1,2)+pizda(2,1)
7448 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7451 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7453 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7456 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7457 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7459 C Derivatives in gamma(l-1) or gamma(j-1)
7462 s1=dip(1,jj,i)*dipderg(3,kk,k)
7464 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7465 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7466 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7467 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7468 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7469 vv(1)=pizda(1,1)-pizda(2,2)
7470 vv(2)=pizda(1,2)+pizda(2,1)
7471 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7474 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7476 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7479 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7480 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7482 C Cartesian derivatives.
7484 write (2,*) 'In eello6_graph2'
7486 write (2,*) 'iii=',iii
7488 write (2,*) 'kkk=',kkk
7490 write (2,'(3(2f10.5),5x)')
7491 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7501 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7503 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7506 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7508 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7509 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7511 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7512 call transpose2(EUg(1,1,k),auxmat(1,1))
7513 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7515 vv(1)=pizda(1,1)-pizda(2,2)
7516 vv(2)=pizda(1,2)+pizda(2,1)
7517 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7518 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7520 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7522 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7525 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7527 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7534 c----------------------------------------------------------------------------
7535 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7536 implicit real*8 (a-h,o-z)
7537 include 'DIMENSIONS'
7538 include 'sizesclu.dat'
7539 include 'COMMON.IOUNITS'
7540 include 'COMMON.CHAIN'
7541 include 'COMMON.DERIV'
7542 include 'COMMON.INTERACT'
7543 include 'COMMON.CONTACTS'
7544 include 'COMMON.TORSION'
7545 include 'COMMON.VAR'
7546 include 'COMMON.GEO'
7547 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7549 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7551 C Parallel Antiparallel C
7557 C j|/k\| / |/k\|l / C
7562 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7564 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7565 C energy moment and not to the cluster cumulant.
7566 iti=itortyp(itype(i))
7567 c if (j.lt.nres-1) then
7568 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7569 itj1=itortyp(itype(j+1))
7573 itk=itortyp(itype(k))
7574 itk1=itortyp(itype(k+1))
7575 c if (l.lt.nres-1) then
7576 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7577 itl1=itortyp(itype(l+1))
7582 s1=dip(4,jj,i)*dip(4,kk,k)
7584 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7585 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7586 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7587 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7588 call transpose2(EE(1,1,itk),auxmat(1,1))
7589 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7590 vv(1)=pizda(1,1)+pizda(2,2)
7591 vv(2)=pizda(2,1)-pizda(1,2)
7592 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7593 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7595 eello6_graph3=-(s1+s2+s3+s4)
7597 eello6_graph3=-(s2+s3+s4)
7600 if (.not. calc_grad) return
7601 C Derivatives in gamma(k-1)
7602 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7603 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7604 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7605 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7606 C Derivatives in gamma(l-1)
7607 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7608 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7609 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7610 vv(1)=pizda(1,1)+pizda(2,2)
7611 vv(2)=pizda(2,1)-pizda(1,2)
7612 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7613 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7614 C Cartesian derivatives.
7620 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7622 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7625 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7627 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7628 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7630 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7631 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7633 vv(1)=pizda(1,1)+pizda(2,2)
7634 vv(2)=pizda(2,1)-pizda(1,2)
7635 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7637 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7639 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7642 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7644 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7646 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7652 c----------------------------------------------------------------------------
7653 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7654 implicit real*8 (a-h,o-z)
7655 include 'DIMENSIONS'
7656 include 'sizesclu.dat'
7657 include 'COMMON.IOUNITS'
7658 include 'COMMON.CHAIN'
7659 include 'COMMON.DERIV'
7660 include 'COMMON.INTERACT'
7661 include 'COMMON.CONTACTS'
7662 include 'COMMON.TORSION'
7663 include 'COMMON.VAR'
7664 include 'COMMON.GEO'
7665 include 'COMMON.FFIELD'
7666 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7667 & auxvec1(2),auxmat1(2,2)
7669 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7671 C Parallel Antiparallel C
7677 C \ j|/k\| \ |/k\|l C
7682 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7684 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7685 C energy moment and not to the cluster cumulant.
7686 cd write (2,*) 'eello_graph4: wturn6',wturn6
7687 iti=itortyp(itype(i))
7688 itj=itortyp(itype(j))
7689 c if (j.lt.nres-1) then
7690 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7691 itj1=itortyp(itype(j+1))
7695 itk=itortyp(itype(k))
7696 c if (k.lt.nres-1) then
7697 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7698 itk1=itortyp(itype(k+1))
7702 itl=itortyp(itype(l))
7703 if (l.lt.nres-1) then
7704 itl1=itortyp(itype(l+1))
7708 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7709 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7710 cd & ' itl',itl,' itl1',itl1
7713 s1=dip(3,jj,i)*dip(3,kk,k)
7715 s1=dip(2,jj,j)*dip(2,kk,l)
7718 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7719 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7721 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7722 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7724 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7725 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7727 call transpose2(EUg(1,1,k),auxmat(1,1))
7728 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7729 vv(1)=pizda(1,1)-pizda(2,2)
7730 vv(2)=pizda(2,1)+pizda(1,2)
7731 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7732 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7734 eello6_graph4=-(s1+s2+s3+s4)
7736 eello6_graph4=-(s2+s3+s4)
7738 if (.not. calc_grad) return
7739 C Derivatives in gamma(i-1)
7743 s1=dipderg(2,jj,i)*dip(3,kk,k)
7745 s1=dipderg(4,jj,j)*dip(2,kk,l)
7748 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7750 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7751 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7753 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7754 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7756 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7757 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7758 cd write (2,*) 'turn6 derivatives'
7760 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7762 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7766 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7768 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7772 C Derivatives in gamma(k-1)
7775 s1=dip(3,jj,i)*dipderg(2,kk,k)
7777 s1=dip(2,jj,j)*dipderg(4,kk,l)
7780 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7781 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7783 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7784 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7786 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7787 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7789 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7790 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7791 vv(1)=pizda(1,1)-pizda(2,2)
7792 vv(2)=pizda(2,1)+pizda(1,2)
7793 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7794 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7796 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7798 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7802 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7804 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7807 C Derivatives in gamma(j-1) or gamma(l-1)
7808 if (l.eq.j+1 .and. l.gt.1) then
7809 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7810 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7811 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7812 vv(1)=pizda(1,1)-pizda(2,2)
7813 vv(2)=pizda(2,1)+pizda(1,2)
7814 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7815 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7816 else if (j.gt.1) then
7817 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7818 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7819 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7820 vv(1)=pizda(1,1)-pizda(2,2)
7821 vv(2)=pizda(2,1)+pizda(1,2)
7822 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7823 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7824 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7826 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7829 C Cartesian derivatives.
7836 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7838 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7842 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7844 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7848 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7850 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7852 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7853 & b1(1,itj1),auxvec(1))
7854 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7856 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7857 & b1(1,itl1),auxvec(1))
7858 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7860 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7862 vv(1)=pizda(1,1)-pizda(2,2)
7863 vv(2)=pizda(2,1)+pizda(1,2)
7864 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7866 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7868 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7871 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7874 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7877 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7879 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7881 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7885 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7887 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7890 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7892 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7900 c----------------------------------------------------------------------------
7901 double precision function eello_turn6(i,jj,kk)
7902 implicit real*8 (a-h,o-z)
7903 include 'DIMENSIONS'
7904 include 'sizesclu.dat'
7905 include 'COMMON.IOUNITS'
7906 include 'COMMON.CHAIN'
7907 include 'COMMON.DERIV'
7908 include 'COMMON.INTERACT'
7909 include 'COMMON.CONTACTS'
7910 include 'COMMON.TORSION'
7911 include 'COMMON.VAR'
7912 include 'COMMON.GEO'
7913 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7914 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7916 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7917 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7918 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7919 C the respective energy moment and not to the cluster cumulant.
7924 iti=itortyp(itype(i))
7925 itk=itortyp(itype(k))
7926 itk1=itortyp(itype(k+1))
7927 itl=itortyp(itype(l))
7928 itj=itortyp(itype(j))
7929 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7930 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7931 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7936 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7938 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7942 derx_turn(lll,kkk,iii)=0.0d0
7949 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7951 cd write (2,*) 'eello6_5',eello6_5
7953 call transpose2(AEA(1,1,1),auxmat(1,1))
7954 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7955 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7956 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7960 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7961 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7962 s2 = scalar2(b1(1,itk),vtemp1(1))
7964 call transpose2(AEA(1,1,2),atemp(1,1))
7965 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7966 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7967 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7971 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7972 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7973 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7975 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7976 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7977 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7978 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7979 ss13 = scalar2(b1(1,itk),vtemp4(1))
7980 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7984 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7990 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7992 C Derivatives in gamma(i+2)
7994 call transpose2(AEA(1,1,1),auxmatd(1,1))
7995 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7996 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7997 call transpose2(AEAderg(1,1,2),atempd(1,1))
7998 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7999 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8003 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8004 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8005 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8011 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8012 C Derivatives in gamma(i+3)
8014 call transpose2(AEA(1,1,1),auxmatd(1,1))
8015 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8016 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8017 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8021 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8022 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8023 s2d = scalar2(b1(1,itk),vtemp1d(1))
8025 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8026 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8028 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8030 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8031 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8032 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8042 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8043 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8045 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8046 & -0.5d0*ekont*(s2d+s12d)
8048 C Derivatives in gamma(i+4)
8049 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8050 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8051 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8053 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8054 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8055 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8065 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8067 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8069 C Derivatives in gamma(i+5)
8071 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8072 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8073 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8077 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8078 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8079 s2d = scalar2(b1(1,itk),vtemp1d(1))
8081 call transpose2(AEA(1,1,2),atempd(1,1))
8082 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8083 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8087 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8088 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8090 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8091 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8092 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8102 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8103 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8105 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8106 & -0.5d0*ekont*(s2d+s12d)
8108 C Cartesian derivatives
8113 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8114 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8115 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8119 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8120 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8122 s2d = scalar2(b1(1,itk),vtemp1d(1))
8124 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8125 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8126 s8d = -(atempd(1,1)+atempd(2,2))*
8127 & scalar2(cc(1,1,itl),vtemp2(1))
8131 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8133 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8134 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8141 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8144 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8148 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8149 & - 0.5d0*(s8d+s12d)
8151 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8160 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8162 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8163 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8164 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8165 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8166 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8168 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8169 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8170 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8174 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8175 cd & 16*eel_turn6_num
8177 if (j.lt.nres-1) then
8184 if (l.lt.nres-1) then
8192 ggg1(ll)=eel_turn6*g_contij(ll,1)
8193 ggg2(ll)=eel_turn6*g_contij(ll,2)
8194 ghalf=0.5d0*ggg1(ll)
8196 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8197 & +ekont*derx_turn(ll,2,1)
8198 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8199 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8200 & +ekont*derx_turn(ll,4,1)
8201 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8202 ghalf=0.5d0*ggg2(ll)
8204 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8205 & +ekont*derx_turn(ll,2,2)
8206 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8207 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8208 & +ekont*derx_turn(ll,4,2)
8209 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8214 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8219 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8225 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8230 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8234 cd write (2,*) iii,g_corr6_loc(iii)
8237 eello_turn6=ekont*eel_turn6
8238 cd write (2,*) 'ekont',ekont
8239 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8242 crc-------------------------------------------------
8243 SUBROUTINE MATVEC2(A1,V1,V2)
8244 implicit real*8 (a-h,o-z)
8245 include 'DIMENSIONS'
8246 DIMENSION A1(2,2),V1(2),V2(2)
8250 c 3 VI=VI+A1(I,K)*V1(K)
8254 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8255 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8260 C---------------------------------------
8261 SUBROUTINE MATMAT2(A1,A2,A3)
8262 implicit real*8 (a-h,o-z)
8263 include 'DIMENSIONS'
8264 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8265 c DIMENSION AI3(2,2)
8269 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8275 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8276 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8277 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8278 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8286 c-------------------------------------------------------------------------
8287 double precision function scalar2(u,v)
8289 double precision u(2),v(2)
8292 scalar2=u(1)*v(1)+u(2)*v(2)
8296 C-----------------------------------------------------------------------------
8298 subroutine transpose2(a,at)
8300 double precision a(2,2),at(2,2)
8307 c--------------------------------------------------------------------------
8308 subroutine transpose(n,a,at)
8311 double precision a(n,n),at(n,n)
8319 C---------------------------------------------------------------------------
8320 subroutine prodmat3(a1,a2,kk,transp,prod)
8323 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8325 crc double precision auxmat(2,2),prod_(2,2)
8328 crc call transpose2(kk(1,1),auxmat(1,1))
8329 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8330 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8332 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8333 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8334 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8335 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8336 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8337 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8338 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8339 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8342 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8343 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8345 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8346 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8347 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8348 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8349 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8350 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8351 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8352 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8355 c call transpose2(a2(1,1),a2t(1,1))
8358 crc print *,((prod_(i,j),i=1,2),j=1,2)
8359 crc print *,((prod(i,j),i=1,2),j=1,2)
8363 C-----------------------------------------------------------------------------
8364 double precision function scalar(u,v)
8366 double precision u(3),v(3)
8376 C-----------------------------------------------------------------------
8377 double precision function sscale(r)
8378 double precision r,gamm
8379 include "COMMON.SPLITELE"
8380 if(r.lt.r_cut-rlamb) then
8382 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8383 gamm=(r-(r_cut-rlamb))/rlamb
8384 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8390 C-----------------------------------------------------------------------
8391 C-----------------------------------------------------------------------
8392 double precision function sscagrad(r)
8393 double precision r,gamm
8394 include "COMMON.SPLITELE"
8395 if(r.lt.r_cut-rlamb) then
8397 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8398 gamm=(r-(r_cut-rlamb))/rlamb
8399 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8405 C-----------------------------------------------------------------------
8406 C first for shielding is setting of function of side-chains
8407 subroutine set_shield_fac2
8408 implicit real*8 (a-h,o-z)
8409 include 'DIMENSIONS'
8410 include 'COMMON.CHAIN'
8411 include 'COMMON.DERIV'
8412 include 'COMMON.IOUNITS'
8413 include 'COMMON.SHIELD'
8414 include 'COMMON.INTERACT'
8415 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8416 double precision div77_81/0.974996043d0/,
8417 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8419 C the vector between center of side_chain and peptide group
8420 double precision pep_side(3),long,side_calf(3),
8421 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8422 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8423 C the line belowe needs to be changed for FGPROC>1
8425 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8427 Cif there two consequtive dummy atoms there is no peptide group between them
8428 C the line below has to be changed for FGPROC>1
8431 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8435 C first lets set vector conecting the ithe side-chain with kth side-chain
8436 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8438 C and vector conecting the side-chain with its proper calfa
8439 side_calf(j)=c(j,k+nres)-c(j,k)
8440 C side_calf(j)=2.0d0
8441 pept_group(j)=c(j,i)-c(j,i+1)
8442 C lets have their lenght
8443 dist_pep_side=pep_side(j)**2+dist_pep_side
8444 dist_side_calf=dist_side_calf+side_calf(j)**2
8445 dist_pept_group=dist_pept_group+pept_group(j)**2
8447 dist_pep_side=dsqrt(dist_pep_side)
8448 dist_pept_group=dsqrt(dist_pept_group)
8449 dist_side_calf=dsqrt(dist_side_calf)
8451 pep_side_norm(j)=pep_side(j)/dist_pep_side
8452 side_calf_norm(j)=dist_side_calf
8454 C now sscale fraction
8455 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8456 C print *,buff_shield,"buff"
8458 if (sh_frac_dist.le.0.0) cycle
8459 C If we reach here it means that this side chain reaches the shielding sphere
8460 C Lets add him to the list for gradient
8461 ishield_list(i)=ishield_list(i)+1
8462 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8463 C this list is essential otherwise problem would be O3
8464 shield_list(ishield_list(i),i)=k
8465 C Lets have the sscale value
8466 if (sh_frac_dist.gt.1.0) then
8467 scale_fac_dist=1.0d0
8469 sh_frac_dist_grad(j)=0.0d0
8472 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8473 & *(2.0d0*sh_frac_dist-3.0d0)
8474 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
8475 & /dist_pep_side/buff_shield*0.5d0
8476 C remember for the final gradient multiply sh_frac_dist_grad(j)
8477 C for side_chain by factor -2 !
8479 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8480 C sh_frac_dist_grad(j)=0.0d0
8481 C scale_fac_dist=1.0d0
8482 C print *,"jestem",scale_fac_dist,fac_help_scale,
8483 C & sh_frac_dist_grad(j)
8486 C this is what is now we have the distance scaling now volume...
8487 short=short_r_sidechain(itype(k))
8488 long=long_r_sidechain(itype(k))
8489 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
8490 sinthet=short/dist_pep_side*costhet
8494 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
8495 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
8496 C & -short/dist_pep_side**2/costhet)
8499 costhet_grad(j)=costhet_fac*pep_side(j)
8501 C remember for the final gradient multiply costhet_grad(j)
8502 C for side_chain by factor -2 !
8503 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8504 C pep_side0pept_group is vector multiplication
8505 pep_side0pept_group=0.0d0
8507 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8509 cosalfa=(pep_side0pept_group/
8510 & (dist_pep_side*dist_side_calf))
8511 fac_alfa_sin=1.0d0-cosalfa**2
8512 fac_alfa_sin=dsqrt(fac_alfa_sin)
8513 rkprim=fac_alfa_sin*(long-short)+short
8517 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
8519 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
8520 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
8524 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8525 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8526 &*(long-short)/fac_alfa_sin*cosalfa/
8527 &((dist_pep_side*dist_side_calf))*
8528 &((side_calf(j))-cosalfa*
8529 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8530 C cosphi_grad_long(j)=0.0d0
8531 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8532 &*(long-short)/fac_alfa_sin*cosalfa
8533 &/((dist_pep_side*dist_side_calf))*
8535 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8536 C cosphi_grad_loc(j)=0.0d0
8538 C print *,sinphi,sinthet
8539 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
8542 C now the gradient...
8544 grad_shield(j,i)=grad_shield(j,i)
8545 C gradient po skalowaniu
8546 & +(sh_frac_dist_grad(j)*VofOverlap
8547 C gradient po costhet
8548 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
8549 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8550 & sinphi/sinthet*costhet*costhet_grad(j)
8551 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8553 C grad_shield_side is Cbeta sidechain gradient
8554 grad_shield_side(j,ishield_list(i),i)=
8555 & (sh_frac_dist_grad(j)*-2.0d0
8557 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8558 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8559 & sinphi/sinthet*costhet*costhet_grad(j)
8560 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8563 grad_shield_loc(j,ishield_list(i),i)=
8564 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8565 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
8566 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
8570 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8572 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
8573 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8577 C first for shielding is setting of function of side-chains
8578 subroutine set_shield_fac
8579 implicit real*8 (a-h,o-z)
8580 include 'DIMENSIONS'
8581 include 'COMMON.CHAIN'
8582 include 'COMMON.DERIV'
8583 include 'COMMON.IOUNITS'
8584 include 'COMMON.SHIELD'
8585 include 'COMMON.INTERACT'
8586 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8587 double precision div77_81/0.974996043d0/,
8588 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8590 C the vector between center of side_chain and peptide group
8591 double precision pep_side(3),long,side_calf(3),
8592 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8593 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8594 C the line belowe needs to be changed for FGPROC>1
8596 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8598 Cif there two consequtive dummy atoms there is no peptide group between them
8599 C the line below has to be changed for FGPROC>1
8602 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8606 C first lets set vector conecting the ithe side-chain with kth side-chain
8607 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8609 C and vector conecting the side-chain with its proper calfa
8610 side_calf(j)=c(j,k+nres)-c(j,k)
8611 C side_calf(j)=2.0d0
8612 pept_group(j)=c(j,i)-c(j,i+1)
8613 C lets have their lenght
8614 dist_pep_side=pep_side(j)**2+dist_pep_side
8615 dist_side_calf=dist_side_calf+side_calf(j)**2
8616 dist_pept_group=dist_pept_group+pept_group(j)**2
8618 dist_pep_side=dsqrt(dist_pep_side)
8619 dist_pept_group=dsqrt(dist_pept_group)
8620 dist_side_calf=dsqrt(dist_side_calf)
8622 pep_side_norm(j)=pep_side(j)/dist_pep_side
8623 side_calf_norm(j)=dist_side_calf
8625 C now sscale fraction
8626 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8627 C print *,buff_shield,"buff"
8629 if (sh_frac_dist.le.0.0) cycle
8630 C If we reach here it means that this side chain reaches the shielding sphere
8631 C Lets add him to the list for gradient
8632 ishield_list(i)=ishield_list(i)+1
8633 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8634 C this list is essential otherwise problem would be O3
8635 shield_list(ishield_list(i),i)=k
8636 C Lets have the sscale value
8637 if (sh_frac_dist.gt.1.0) then
8638 scale_fac_dist=1.0d0
8640 sh_frac_dist_grad(j)=0.0d0
8643 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8644 & *(2.0*sh_frac_dist-3.0d0)
8645 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8646 & /dist_pep_side/buff_shield*0.5
8647 C remember for the final gradient multiply sh_frac_dist_grad(j)
8648 C for side_chain by factor -2 !
8650 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8651 C print *,"jestem",scale_fac_dist,fac_help_scale,
8652 C & sh_frac_dist_grad(j)
8655 C if ((i.eq.3).and.(k.eq.2)) then
8656 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8660 C this is what is now we have the distance scaling now volume...
8661 short=short_r_sidechain(itype(k))
8662 long=long_r_sidechain(itype(k))
8663 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8666 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8669 costhet_grad(j)=costhet_fac*pep_side(j)
8671 C remember for the final gradient multiply costhet_grad(j)
8672 C for side_chain by factor -2 !
8673 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8674 C pep_side0pept_group is vector multiplication
8675 pep_side0pept_group=0.0
8677 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8679 cosalfa=(pep_side0pept_group/
8680 & (dist_pep_side*dist_side_calf))
8681 fac_alfa_sin=1.0-cosalfa**2
8682 fac_alfa_sin=dsqrt(fac_alfa_sin)
8683 rkprim=fac_alfa_sin*(long-short)+short
8685 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8686 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8689 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8690 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8691 &*(long-short)/fac_alfa_sin*cosalfa/
8692 &((dist_pep_side*dist_side_calf))*
8693 &((side_calf(j))-cosalfa*
8694 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8696 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8697 &*(long-short)/fac_alfa_sin*cosalfa
8698 &/((dist_pep_side*dist_side_calf))*
8700 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8703 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8706 C now the gradient...
8707 C grad_shield is gradient of Calfa for peptide groups
8708 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8710 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8711 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8713 grad_shield(j,i)=grad_shield(j,i)
8714 C gradient po skalowaniu
8715 & +(sh_frac_dist_grad(j)
8716 C gradient po costhet
8717 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8718 &-scale_fac_dist*(cosphi_grad_long(j))
8719 &/(1.0-cosphi) )*div77_81
8721 C grad_shield_side is Cbeta sidechain gradient
8722 grad_shield_side(j,ishield_list(i),i)=
8723 & (sh_frac_dist_grad(j)*-2.0d0
8724 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
8725 & +scale_fac_dist*(cosphi_grad_long(j))
8726 & *2.0d0/(1.0-cosphi))
8727 & *div77_81*VofOverlap
8729 grad_shield_loc(j,ishield_list(i),i)=
8730 & scale_fac_dist*cosphi_grad_loc(j)
8731 & *2.0d0/(1.0-cosphi)
8732 & *div77_81*VofOverlap
8734 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8736 fac_shield(i)=VolumeTotal*div77_81+div4_81
8737 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8741 C--------------------------------------------------------------------------