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 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 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 /.true./
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)
1049 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1050 & restyp(itypi),i,restyp(itypj),j,
1051 & epsi,sigm,chi1,chi2,chip1,chip2,
1052 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1053 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1055 write (iout,*) "pratial sum", evdw,evdw_t
1058 C Calculate gradient components.
1059 e1=e1*eps1*eps2rt**2*eps3rt**2
1060 fac=-expon*(e1+evdwij)*rij_shift
1063 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1064 C Calculate the radial part of the gradient
1068 C Calculate angular part of the gradient.
1077 C-----------------------------------------------------------------------------
1078 subroutine egbv(evdw,evdw_t)
1080 C This subroutine calculates the interaction energy of nonbonded side chains
1081 C assuming the Gay-Berne-Vorobjev potential of interaction.
1083 implicit real*8 (a-h,o-z)
1084 include 'DIMENSIONS'
1085 include 'sizesclu.dat'
1086 include "DIMENSIONS.COMPAR"
1087 include 'COMMON.GEO'
1088 include 'COMMON.VAR'
1089 include 'COMMON.LOCAL'
1090 include 'COMMON.CHAIN'
1091 include 'COMMON.DERIV'
1092 include 'COMMON.NAMES'
1093 include 'COMMON.INTERACT'
1094 include 'COMMON.IOUNITS'
1095 include 'COMMON.CALC'
1096 common /srutu/ icall
1102 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1105 c if (icall.gt.0) lprn=.true.
1107 do i=iatsc_s,iatsc_e
1108 itypi=iabs(itype(i))
1109 if (itypi.eq.ntyp1) cycle
1110 itypi1=iabs(itype(i+1))
1114 dxi=dc_norm(1,nres+i)
1115 dyi=dc_norm(2,nres+i)
1116 dzi=dc_norm(3,nres+i)
1117 dsci_inv=vbld_inv(i+nres)
1119 C Calculate SC interaction energy.
1121 do iint=1,nint_gr(i)
1122 do j=istart(i,iint),iend(i,iint)
1124 itypj=iabs(itype(j))
1125 if (itypj.eq.ntyp1) cycle
1126 dscj_inv=vbld_inv(j+nres)
1127 sig0ij=sigma(itypi,itypj)
1128 r0ij=r0(itypi,itypj)
1129 chi1=chi(itypi,itypj)
1130 chi2=chi(itypj,itypi)
1137 alf12=0.5D0*(alf1+alf2)
1138 C For diagnostics only!!!
1151 dxj=dc_norm(1,nres+j)
1152 dyj=dc_norm(2,nres+j)
1153 dzj=dc_norm(3,nres+j)
1154 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1156 C Calculate angle-dependent terms of energy and contributions to their
1160 sig=sig0ij*dsqrt(sigsq)
1161 rij_shift=1.0D0/rij-sig+r0ij
1162 C I hate to put IF's in the loops, but here don't have another choice!!!!
1163 if (rij_shift.le.0.0D0) then
1168 c---------------------------------------------------------------
1169 rij_shift=1.0D0/rij_shift
1170 fac=rij_shift**expon
1171 e1=fac*fac*aa(itypi,itypj)
1172 e2=fac*bb(itypi,itypj)
1173 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1174 eps2der=evdwij*eps3rt
1175 eps3der=evdwij*eps2rt
1176 fac_augm=rrij**expon
1177 e_augm=augm(itypi,itypj)*fac_augm
1178 evdwij=evdwij*eps2rt*eps3rt
1179 if (bb(itypi,itypj).gt.0.0d0) then
1180 evdw=evdw+evdwij+e_augm
1182 evdw_t=evdw_t+evdwij+e_augm
1184 ij=icant(itypi,itypj)
1185 aux=eps1*eps2rt**2*eps3rt**2
1187 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1188 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1189 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1190 c & restyp(itypi),i,restyp(itypj),j,
1191 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1192 c & chi1,chi2,chip1,chip2,
1193 c & eps1,eps2rt**2,eps3rt**2,
1194 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1198 C Calculate gradient components.
1199 e1=e1*eps1*eps2rt**2*eps3rt**2
1200 fac=-expon*(e1+evdwij)*rij_shift
1202 fac=rij*fac-2*expon*rrij*e_augm
1203 C Calculate the radial part of the gradient
1207 C Calculate angular part of the gradient.
1215 C-----------------------------------------------------------------------------
1216 subroutine sc_angular
1217 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1218 C om12. Called by ebp, egb, and egbv.
1220 include 'COMMON.CALC'
1224 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1225 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1226 om12=dxi*dxj+dyi*dyj+dzi*dzj
1228 C Calculate eps1(om12) and its derivative in om12
1229 faceps1=1.0D0-om12*chiom12
1230 faceps1_inv=1.0D0/faceps1
1231 eps1=dsqrt(faceps1_inv)
1232 C Following variable is eps1*deps1/dom12
1233 eps1_om12=faceps1_inv*chiom12
1234 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1239 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1240 sigsq=1.0D0-facsig*faceps1_inv
1241 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1242 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1243 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1244 C Calculate eps2 and its derivatives in om1, om2, and om12.
1247 chipom12=chip12*om12
1248 facp=1.0D0-om12*chipom12
1250 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1251 C Following variable is the square root of eps2
1252 eps2rt=1.0D0-facp1*facp_inv
1253 C Following three variables are the derivatives of the square root of eps
1254 C in om1, om2, and om12.
1255 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1256 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1257 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1258 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1259 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1260 C Calculate whole angle-dependent part of epsilon and contributions
1261 C to its derivatives
1264 C----------------------------------------------------------------------------
1266 implicit real*8 (a-h,o-z)
1267 include 'DIMENSIONS'
1268 include 'sizesclu.dat'
1269 include 'COMMON.CHAIN'
1270 include 'COMMON.DERIV'
1271 include 'COMMON.CALC'
1272 double precision dcosom1(3),dcosom2(3)
1273 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1274 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1275 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1276 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1278 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1279 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1282 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1285 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1286 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1287 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1288 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1289 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1290 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1293 C Calculate the components of the gradient in DC and X
1297 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1302 c------------------------------------------------------------------------------
1303 subroutine vec_and_deriv
1304 implicit real*8 (a-h,o-z)
1305 include 'DIMENSIONS'
1306 include 'sizesclu.dat'
1307 include 'COMMON.IOUNITS'
1308 include 'COMMON.GEO'
1309 include 'COMMON.VAR'
1310 include 'COMMON.LOCAL'
1311 include 'COMMON.CHAIN'
1312 include 'COMMON.VECTORS'
1313 include 'COMMON.DERIV'
1314 include 'COMMON.INTERACT'
1315 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1316 C Compute the local reference systems. For reference system (i), the
1317 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1318 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1320 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1321 if (i.eq.nres-1) then
1322 C Case of the last full residue
1323 C Compute the Z-axis
1324 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1325 costh=dcos(pi-theta(nres))
1326 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1331 C Compute the derivatives of uz
1333 uzder(2,1,1)=-dc_norm(3,i-1)
1334 uzder(3,1,1)= dc_norm(2,i-1)
1335 uzder(1,2,1)= dc_norm(3,i-1)
1337 uzder(3,2,1)=-dc_norm(1,i-1)
1338 uzder(1,3,1)=-dc_norm(2,i-1)
1339 uzder(2,3,1)= dc_norm(1,i-1)
1342 uzder(2,1,2)= dc_norm(3,i)
1343 uzder(3,1,2)=-dc_norm(2,i)
1344 uzder(1,2,2)=-dc_norm(3,i)
1346 uzder(3,2,2)= dc_norm(1,i)
1347 uzder(1,3,2)= dc_norm(2,i)
1348 uzder(2,3,2)=-dc_norm(1,i)
1351 C Compute the Y-axis
1354 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1357 C Compute the derivatives of uy
1360 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1361 & -dc_norm(k,i)*dc_norm(j,i-1)
1362 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1364 uyder(j,j,1)=uyder(j,j,1)-costh
1365 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1370 uygrad(l,k,j,i)=uyder(l,k,j)
1371 uzgrad(l,k,j,i)=uzder(l,k,j)
1375 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1376 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1377 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1378 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1382 C Compute the Z-axis
1383 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1384 costh=dcos(pi-theta(i+2))
1385 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1390 C Compute the derivatives of uz
1392 uzder(2,1,1)=-dc_norm(3,i+1)
1393 uzder(3,1,1)= dc_norm(2,i+1)
1394 uzder(1,2,1)= dc_norm(3,i+1)
1396 uzder(3,2,1)=-dc_norm(1,i+1)
1397 uzder(1,3,1)=-dc_norm(2,i+1)
1398 uzder(2,3,1)= dc_norm(1,i+1)
1401 uzder(2,1,2)= dc_norm(3,i)
1402 uzder(3,1,2)=-dc_norm(2,i)
1403 uzder(1,2,2)=-dc_norm(3,i)
1405 uzder(3,2,2)= dc_norm(1,i)
1406 uzder(1,3,2)= dc_norm(2,i)
1407 uzder(2,3,2)=-dc_norm(1,i)
1410 C Compute the Y-axis
1413 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1416 C Compute the derivatives of uy
1419 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1420 & -dc_norm(k,i)*dc_norm(j,i+1)
1421 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1423 uyder(j,j,1)=uyder(j,j,1)-costh
1424 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1429 uygrad(l,k,j,i)=uyder(l,k,j)
1430 uzgrad(l,k,j,i)=uzder(l,k,j)
1434 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1435 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1436 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1437 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1443 vbld_inv_temp(1)=vbld_inv(i+1)
1444 if (i.lt.nres-1) then
1445 vbld_inv_temp(2)=vbld_inv(i+2)
1447 vbld_inv_temp(2)=vbld_inv(i)
1452 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1453 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1461 C-----------------------------------------------------------------------------
1462 subroutine vec_and_deriv_test
1463 implicit real*8 (a-h,o-z)
1464 include 'DIMENSIONS'
1465 include 'sizesclu.dat'
1466 include 'COMMON.IOUNITS'
1467 include 'COMMON.GEO'
1468 include 'COMMON.VAR'
1469 include 'COMMON.LOCAL'
1470 include 'COMMON.CHAIN'
1471 include 'COMMON.VECTORS'
1472 dimension uyder(3,3,2),uzder(3,3,2)
1473 C Compute the local reference systems. For reference system (i), the
1474 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1475 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1477 if (i.eq.nres-1) then
1478 C Case of the last full residue
1479 C Compute the Z-axis
1480 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1481 costh=dcos(pi-theta(nres))
1482 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1483 c write (iout,*) 'fac',fac,
1484 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1485 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1489 C Compute the derivatives of uz
1491 uzder(2,1,1)=-dc_norm(3,i-1)
1492 uzder(3,1,1)= dc_norm(2,i-1)
1493 uzder(1,2,1)= dc_norm(3,i-1)
1495 uzder(3,2,1)=-dc_norm(1,i-1)
1496 uzder(1,3,1)=-dc_norm(2,i-1)
1497 uzder(2,3,1)= dc_norm(1,i-1)
1500 uzder(2,1,2)= dc_norm(3,i)
1501 uzder(3,1,2)=-dc_norm(2,i)
1502 uzder(1,2,2)=-dc_norm(3,i)
1504 uzder(3,2,2)= dc_norm(1,i)
1505 uzder(1,3,2)= dc_norm(2,i)
1506 uzder(2,3,2)=-dc_norm(1,i)
1508 C Compute the Y-axis
1510 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1513 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1514 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1515 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1517 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1520 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1521 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1524 c write (iout,*) 'facy',facy,
1525 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1526 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1528 uy(k,i)=facy*uy(k,i)
1530 C Compute the derivatives of uy
1533 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1534 & -dc_norm(k,i)*dc_norm(j,i-1)
1535 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1537 c uyder(j,j,1)=uyder(j,j,1)-costh
1538 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1539 uyder(j,j,1)=uyder(j,j,1)
1540 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1541 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1547 uygrad(l,k,j,i)=uyder(l,k,j)
1548 uzgrad(l,k,j,i)=uzder(l,k,j)
1552 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1553 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1554 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1555 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1558 C Compute the Z-axis
1559 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1560 costh=dcos(pi-theta(i+2))
1561 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1562 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1566 C Compute the derivatives of uz
1568 uzder(2,1,1)=-dc_norm(3,i+1)
1569 uzder(3,1,1)= dc_norm(2,i+1)
1570 uzder(1,2,1)= dc_norm(3,i+1)
1572 uzder(3,2,1)=-dc_norm(1,i+1)
1573 uzder(1,3,1)=-dc_norm(2,i+1)
1574 uzder(2,3,1)= dc_norm(1,i+1)
1577 uzder(2,1,2)= dc_norm(3,i)
1578 uzder(3,1,2)=-dc_norm(2,i)
1579 uzder(1,2,2)=-dc_norm(3,i)
1581 uzder(3,2,2)= dc_norm(1,i)
1582 uzder(1,3,2)= dc_norm(2,i)
1583 uzder(2,3,2)=-dc_norm(1,i)
1585 C Compute the Y-axis
1587 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1588 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1589 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1591 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1594 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1595 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1598 c write (iout,*) 'facy',facy,
1599 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1600 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1602 uy(k,i)=facy*uy(k,i)
1604 C Compute the derivatives of uy
1607 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1608 & -dc_norm(k,i)*dc_norm(j,i+1)
1609 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1611 c uyder(j,j,1)=uyder(j,j,1)-costh
1612 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1613 uyder(j,j,1)=uyder(j,j,1)
1614 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1615 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1621 uygrad(l,k,j,i)=uyder(l,k,j)
1622 uzgrad(l,k,j,i)=uzder(l,k,j)
1626 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1627 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1628 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1629 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1636 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1637 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1644 C-----------------------------------------------------------------------------
1645 subroutine check_vecgrad
1646 implicit real*8 (a-h,o-z)
1647 include 'DIMENSIONS'
1648 include 'sizesclu.dat'
1649 include 'COMMON.IOUNITS'
1650 include 'COMMON.GEO'
1651 include 'COMMON.VAR'
1652 include 'COMMON.LOCAL'
1653 include 'COMMON.CHAIN'
1654 include 'COMMON.VECTORS'
1655 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1656 dimension uyt(3,maxres),uzt(3,maxres)
1657 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1658 double precision delta /1.0d-7/
1661 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1662 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1663 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1664 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1665 cd & (dc_norm(if90,i),if90=1,3)
1666 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1667 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1668 cd write(iout,'(a)')
1674 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1675 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1688 cd write (iout,*) 'i=',i
1690 erij(k)=dc_norm(k,i)
1694 dc_norm(k,i)=erij(k)
1696 dc_norm(j,i)=dc_norm(j,i)+delta
1697 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1699 c dc_norm(k,i)=dc_norm(k,i)/fac
1701 c write (iout,*) (dc_norm(k,i),k=1,3)
1702 c write (iout,*) (erij(k),k=1,3)
1705 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1706 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1707 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1708 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1710 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1711 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1712 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1715 dc_norm(k,i)=erij(k)
1718 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1719 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1720 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1721 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1722 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1723 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1724 cd write (iout,'(a)')
1729 C--------------------------------------------------------------------------
1730 subroutine set_matrices
1731 implicit real*8 (a-h,o-z)
1732 include 'DIMENSIONS'
1733 include 'sizesclu.dat'
1734 include 'COMMON.IOUNITS'
1735 include 'COMMON.GEO'
1736 include 'COMMON.VAR'
1737 include 'COMMON.LOCAL'
1738 include 'COMMON.CHAIN'
1739 include 'COMMON.DERIV'
1740 include 'COMMON.INTERACT'
1741 include 'COMMON.CONTACTS'
1742 include 'COMMON.TORSION'
1743 include 'COMMON.VECTORS'
1744 include 'COMMON.FFIELD'
1745 double precision auxvec(2),auxmat(2,2)
1747 C Compute the virtual-bond-torsional-angle dependent quantities needed
1748 C to calculate the el-loc multibody terms of various order.
1751 if (i .lt. nres+1) then
1788 if (i .gt. 3 .and. i .lt. nres+1) then
1789 obrot_der(1,i-2)=-sin1
1790 obrot_der(2,i-2)= cos1
1791 Ugder(1,1,i-2)= sin1
1792 Ugder(1,2,i-2)=-cos1
1793 Ugder(2,1,i-2)=-cos1
1794 Ugder(2,2,i-2)=-sin1
1797 obrot2_der(1,i-2)=-dwasin2
1798 obrot2_der(2,i-2)= dwacos2
1799 Ug2der(1,1,i-2)= dwasin2
1800 Ug2der(1,2,i-2)=-dwacos2
1801 Ug2der(2,1,i-2)=-dwacos2
1802 Ug2der(2,2,i-2)=-dwasin2
1804 obrot_der(1,i-2)=0.0d0
1805 obrot_der(2,i-2)=0.0d0
1806 Ugder(1,1,i-2)=0.0d0
1807 Ugder(1,2,i-2)=0.0d0
1808 Ugder(2,1,i-2)=0.0d0
1809 Ugder(2,2,i-2)=0.0d0
1810 obrot2_der(1,i-2)=0.0d0
1811 obrot2_der(2,i-2)=0.0d0
1812 Ug2der(1,1,i-2)=0.0d0
1813 Ug2der(1,2,i-2)=0.0d0
1814 Ug2der(2,1,i-2)=0.0d0
1815 Ug2der(2,2,i-2)=0.0d0
1817 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1818 if (itype(i-2).le.ntyp) then
1819 iti = itortyp(itype(i-2))
1826 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1827 if (itype(i-1).le.ntyp) then
1828 iti1 = itortyp(itype(i-1))
1835 cd write (iout,*) '*******i',i,' iti1',iti
1836 cd write (iout,*) 'b1',b1(:,iti)
1837 cd write (iout,*) 'b2',b2(:,iti)
1838 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1839 c print *,"itilde1 i iti iti1",i,iti,iti1
1840 if (i .gt. iatel_s+2) then
1841 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1842 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1843 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1844 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1845 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1846 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1847 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1857 DtUg2(l,k,i-2)=0.0d0
1861 c print *,"itilde2 i iti iti1",i,iti,iti1
1862 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1863 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1864 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1865 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1866 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1867 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1868 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1869 c print *,"itilde3 i iti iti1",i,iti,iti1
1871 muder(k,i-2)=Ub2der(k,i-2)
1873 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1874 if (itype(i-1).le.ntyp) then
1875 iti1 = itortyp(itype(i-1))
1883 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1885 C Vectors and matrices dependent on a single virtual-bond dihedral.
1886 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1887 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1888 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1889 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1890 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1891 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1892 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1893 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1894 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1895 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1896 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1898 C Matrices dependent on two consecutive virtual-bond dihedrals.
1899 C The order of matrices is from left to right.
1901 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1902 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1903 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1904 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1905 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1906 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1907 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1908 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1911 cd iti = itortyp(itype(i))
1914 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1915 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1920 C--------------------------------------------------------------------------
1921 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1923 C This subroutine calculates the average interaction energy and its gradient
1924 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1925 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1926 C The potential depends both on the distance of peptide-group centers and on
1927 C the orientation of the CA-CA virtual bonds.
1929 implicit real*8 (a-h,o-z)
1930 include 'DIMENSIONS'
1931 include 'sizesclu.dat'
1932 include 'COMMON.CONTROL'
1933 include 'COMMON.IOUNITS'
1934 include 'COMMON.GEO'
1935 include 'COMMON.VAR'
1936 include 'COMMON.LOCAL'
1937 include 'COMMON.CHAIN'
1938 include 'COMMON.DERIV'
1939 include 'COMMON.INTERACT'
1940 include 'COMMON.CONTACTS'
1941 include 'COMMON.TORSION'
1942 include 'COMMON.VECTORS'
1943 include 'COMMON.FFIELD'
1944 include 'COMMON.SHIELD'
1946 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1947 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1948 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1949 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1950 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1951 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1952 double precision scal_el /0.5d0/
1954 C 13-go grudnia roku pamietnego...
1955 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1956 & 0.0d0,1.0d0,0.0d0,
1957 & 0.0d0,0.0d0,1.0d0/
1958 cd write(iout,*) 'In EELEC'
1960 cd write(iout,*) 'Type',i
1961 cd write(iout,*) 'B1',B1(:,i)
1962 cd write(iout,*) 'B2',B2(:,i)
1963 cd write(iout,*) 'CC',CC(:,:,i)
1964 cd write(iout,*) 'DD',DD(:,:,i)
1965 cd write(iout,*) 'EE',EE(:,:,i)
1967 cd call check_vecgrad
1969 if (icheckgrad.eq.1) then
1971 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1973 dc_norm(k,i)=dc(k,i)*fac
1975 c write (iout,*) 'i',i,' fac',fac
1978 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1979 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1980 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1981 cd if (wel_loc.gt.0.0d0) then
1982 if (icheckgrad.eq.1) then
1983 call vec_and_deriv_test
1990 cd write (iout,*) 'i=',i
1992 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1995 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1996 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2009 cd print '(a)','Enter EELEC'
2010 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2012 gel_loc_loc(i)=0.0d0
2015 do i=iatel_s,iatel_e
2017 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2018 C & .or. itype(i+2).eq.ntyp1) cycle
2020 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2021 C & .or. itype(i+2).eq.ntyp1
2022 C & .or. itype(i-1).eq.ntyp1
2025 if (itel(i).eq.0) goto 1215
2029 dx_normi=dc_norm(1,i)
2030 dy_normi=dc_norm(2,i)
2031 dz_normi=dc_norm(3,i)
2032 xmedi=c(1,i)+0.5d0*dxi
2033 ymedi=c(2,i)+0.5d0*dyi
2034 zmedi=c(3,i)+0.5d0*dzi
2035 xmedi=mod(xmedi,boxxsize)
2036 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2037 ymedi=mod(ymedi,boxysize)
2038 if (ymedi.lt.0) ymedi=ymedi+boxysize
2039 zmedi=mod(zmedi,boxzsize)
2040 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2042 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2043 do j=ielstart(i),ielend(i)
2045 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2046 C & .or.itype(j+2).eq.ntyp1
2049 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2050 C & .or.itype(j+2).eq.ntyp1
2051 C & .or.itype(j-1).eq.ntyp1
2054 if (itel(j).eq.0) goto 1216
2058 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2059 aaa=app(iteli,itelj)
2060 bbb=bpp(iteli,itelj)
2061 C Diagnostics only!!!
2067 ael6i=ael6(iteli,itelj)
2068 ael3i=ael3(iteli,itelj)
2072 dx_normj=dc_norm(1,j)
2073 dy_normj=dc_norm(2,j)
2074 dz_normj=dc_norm(3,j)
2079 if (xj.lt.0) xj=xj+boxxsize
2081 if (yj.lt.0) yj=yj+boxysize
2083 if (zj.lt.0) zj=zj+boxzsize
2084 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2092 xj=xj_safe+xshift*boxxsize
2093 yj=yj_safe+yshift*boxysize
2094 zj=zj_safe+zshift*boxzsize
2095 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2096 if(dist_temp.lt.dist_init) then
2106 if (isubchap.eq.1) then
2116 rij=xj*xj+yj*yj+zj*zj
2117 sss=sscale(sqrt(rij))
2118 sssgrad=sscagrad(sqrt(rij))
2124 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2125 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2126 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2127 fac=cosa-3.0D0*cosb*cosg
2129 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2130 if (j.eq.i+2) ev1=scal_el*ev1
2135 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2138 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2139 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2140 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2141 if (shield_mode.gt.0) then
2144 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2145 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2155 evdw1=evdw1+evdwij*sss
2156 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2157 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2158 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2159 cd & xmedi,ymedi,zmedi,xj,yj,zj
2161 C Calculate contributions to the Cartesian gradient.
2164 facvdw=-6*rrmij*(ev1+evdwij)*sss
2165 facel=-3*rrmij*(el1+eesij)
2172 * Radial derivatives. First process both termini of the fragment (i,j)
2178 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2179 & (shield_mode.gt.0)) then
2181 do ilist=1,ishield_list(i)
2182 iresshield=shield_list(ilist,i)
2184 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2186 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2188 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2189 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2190 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2191 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2192 C if (iresshield.gt.i) then
2193 C do ishi=i+1,iresshield-1
2194 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2195 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2199 C do ishi=iresshield,i
2200 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2201 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2209 do ilist=1,ishield_list(j)
2210 iresshield=shield_list(ilist,j)
2212 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2214 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2216 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2217 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2222 gshieldc(k,i)=gshieldc(k,i)+
2223 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2224 gshieldc(k,j)=gshieldc(k,j)+
2225 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2226 gshieldc(k,i-1)=gshieldc(k,i-1)+
2227 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2228 gshieldc(k,j-1)=gshieldc(k,j-1)+
2229 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2236 gelc(k,i)=gelc(k,i)+ghalf
2237 gelc(k,j)=gelc(k,j)+ghalf
2240 * Loop over residues i+1 thru j-1.
2244 gelc(l,k)=gelc(l,k)+ggg(l)
2250 if (sss.gt.0.0) then
2251 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2252 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2253 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2261 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2262 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2265 * Loop over residues i+1 thru j-1.
2269 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2273 facvdw=(ev1+evdwij)*sss
2276 fac=-3*rrmij*(facvdw+facvdw+facel)
2282 * Radial derivatives. First process both termini of the fragment (i,j)
2289 gelc(k,i)=gelc(k,i)+ghalf
2290 gelc(k,j)=gelc(k,j)+ghalf
2293 * Loop over residues i+1 thru j-1.
2297 gelc(l,k)=gelc(l,k)+ggg(l)
2304 ecosa=2.0D0*fac3*fac1+fac4
2307 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2308 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2310 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2311 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2313 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2314 cd & (dcosg(k),k=1,3)
2316 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2317 & *fac_shield(i)**2*fac_shield(j)**2
2321 gelc(k,i)=gelc(k,i)+ghalf
2322 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2323 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2324 & *fac_shield(i)**2*fac_shield(j)**2
2326 gelc(k,j)=gelc(k,j)+ghalf
2327 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2328 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2329 & *fac_shield(i)**2*fac_shield(j)**2
2333 gelc(l,k)=gelc(l,k)+ggg(l)
2338 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2339 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2340 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2342 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2343 C energy of a peptide unit is assumed in the form of a second-order
2344 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2345 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2346 C are computed for EVERY pair of non-contiguous peptide groups.
2348 if (j.lt.nres-1) then
2359 muij(kkk)=mu(k,i)*mu(l,j)
2362 cd write (iout,*) 'EELEC: i',i,' j',j
2363 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2364 cd write(iout,*) 'muij',muij
2365 ury=scalar(uy(1,i),erij)
2366 urz=scalar(uz(1,i),erij)
2367 vry=scalar(uy(1,j),erij)
2368 vrz=scalar(uz(1,j),erij)
2369 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2370 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2371 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2372 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2373 C For diagnostics only
2378 fac=dsqrt(-ael6i)*r3ij
2379 cd write (2,*) 'fac=',fac
2380 C For diagnostics only
2386 cd write (iout,'(4i5,4f10.5)')
2387 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2388 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2389 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2390 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2391 cd write (iout,'(4f10.5)')
2392 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2393 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2394 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2395 cd write (iout,'(2i3,9f10.5/)') i,j,
2396 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2398 C Derivatives of the elements of A in virtual-bond vectors
2399 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2406 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2407 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2408 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2409 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2410 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2411 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2412 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2413 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2414 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2415 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2416 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2417 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2427 C Compute radial contributions to the gradient
2449 C Add the contributions coming from er
2452 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2453 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2454 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2455 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2458 C Derivatives in DC(i)
2459 ghalf1=0.5d0*agg(k,1)
2460 ghalf2=0.5d0*agg(k,2)
2461 ghalf3=0.5d0*agg(k,3)
2462 ghalf4=0.5d0*agg(k,4)
2463 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2464 & -3.0d0*uryg(k,2)*vry)+ghalf1
2465 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2466 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2467 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2468 & -3.0d0*urzg(k,2)*vry)+ghalf3
2469 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2470 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2471 C Derivatives in DC(i+1)
2472 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2473 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2474 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2475 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2476 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2477 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2478 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2479 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2480 C Derivatives in DC(j)
2481 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2482 & -3.0d0*vryg(k,2)*ury)+ghalf1
2483 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2484 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2485 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2486 & -3.0d0*vryg(k,2)*urz)+ghalf3
2487 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2488 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2489 C Derivatives in DC(j+1) or DC(nres-1)
2490 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2491 & -3.0d0*vryg(k,3)*ury)
2492 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2493 & -3.0d0*vrzg(k,3)*ury)
2494 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2495 & -3.0d0*vryg(k,3)*urz)
2496 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2497 & -3.0d0*vrzg(k,3)*urz)
2502 C Derivatives in DC(i+1)
2503 cd aggi1(k,1)=agg(k,1)
2504 cd aggi1(k,2)=agg(k,2)
2505 cd aggi1(k,3)=agg(k,3)
2506 cd aggi1(k,4)=agg(k,4)
2507 C Derivatives in DC(j)
2512 C Derivatives in DC(j+1)
2517 if (j.eq.nres-1 .and. i.lt.j-2) then
2519 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2520 cd aggj1(k,l)=agg(k,l)
2526 C Check the loc-el terms by numerical integration
2536 aggi(k,l)=-aggi(k,l)
2537 aggi1(k,l)=-aggi1(k,l)
2538 aggj(k,l)=-aggj(k,l)
2539 aggj1(k,l)=-aggj1(k,l)
2542 if (j.lt.nres-1) then
2548 aggi(k,l)=-aggi(k,l)
2549 aggi1(k,l)=-aggi1(k,l)
2550 aggj(k,l)=-aggj(k,l)
2551 aggj1(k,l)=-aggj1(k,l)
2562 aggi(k,l)=-aggi(k,l)
2563 aggi1(k,l)=-aggi1(k,l)
2564 aggj(k,l)=-aggj(k,l)
2565 aggj1(k,l)=-aggj1(k,l)
2571 IF (wel_loc.gt.0.0d0) THEN
2572 C Contribution to the local-electrostatic energy coming from the i-j pair
2573 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2575 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2576 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2577 if (shield_mode.eq.0) then
2584 eel_loc_ij=eel_loc_ij
2585 & *fac_shield(i)*fac_shield(j)
2586 eel_loc=eel_loc+eel_loc_ij
2587 C Partial derivatives in virtual-bond dihedral angles gamma
2589 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2590 & (shield_mode.gt.0)) then
2593 do ilist=1,ishield_list(i)
2594 iresshield=shield_list(ilist,i)
2596 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2599 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2601 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2602 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2606 do ilist=1,ishield_list(j)
2607 iresshield=shield_list(ilist,j)
2609 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2612 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2614 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2615 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2621 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2622 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2623 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2624 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2625 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2626 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2627 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2628 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2632 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2633 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2634 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2635 & *fac_shield(i)*fac_shield(j)
2636 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2637 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2638 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2639 & *fac_shield(i)*fac_shield(j)
2641 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2642 cd write(iout,*) 'agg ',agg
2643 cd write(iout,*) 'aggi ',aggi
2644 cd write(iout,*) 'aggi1',aggi1
2645 cd write(iout,*) 'aggj ',aggj
2646 cd write(iout,*) 'aggj1',aggj1
2648 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2650 ggg(l)=agg(l,1)*muij(1)+
2651 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2652 & *fac_shield(i)*fac_shield(j)
2657 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2660 C Remaining derivatives of eello
2662 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2663 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2664 & *fac_shield(i)*fac_shield(j)
2666 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2667 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2668 & *fac_shield(i)*fac_shield(j)
2670 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2671 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2672 & *fac_shield(i)*fac_shield(j)
2674 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2675 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2676 & *fac_shield(i)*fac_shield(j)
2681 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2682 C Contributions from turns
2687 call eturn34(i,j,eello_turn3,eello_turn4)
2689 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2690 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2692 C Calculate the contact function. The ith column of the array JCONT will
2693 C contain the numbers of atoms that make contacts with the atom I (of numbers
2694 C greater than I). The arrays FACONT and GACONT will contain the values of
2695 C the contact function and its derivative.
2696 c r0ij=1.02D0*rpp(iteli,itelj)
2697 c r0ij=1.11D0*rpp(iteli,itelj)
2698 r0ij=2.20D0*rpp(iteli,itelj)
2699 c r0ij=1.55D0*rpp(iteli,itelj)
2700 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2701 if (fcont.gt.0.0D0) then
2702 num_conti=num_conti+1
2703 if (num_conti.gt.maxconts) then
2704 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2705 & ' will skip next contacts for this conf.'
2707 jcont_hb(num_conti,i)=j
2708 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2709 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2710 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2712 d_cont(num_conti,i)=rij
2713 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2714 C --- Electrostatic-interaction matrix ---
2715 a_chuj(1,1,num_conti,i)=a22
2716 a_chuj(1,2,num_conti,i)=a23
2717 a_chuj(2,1,num_conti,i)=a32
2718 a_chuj(2,2,num_conti,i)=a33
2719 C --- Gradient of rij
2721 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2724 c a_chuj(1,1,num_conti,i)=-0.61d0
2725 c a_chuj(1,2,num_conti,i)= 0.4d0
2726 c a_chuj(2,1,num_conti,i)= 0.65d0
2727 c a_chuj(2,2,num_conti,i)= 0.50d0
2728 c else if (i.eq.2) then
2729 c a_chuj(1,1,num_conti,i)= 0.0d0
2730 c a_chuj(1,2,num_conti,i)= 0.0d0
2731 c a_chuj(2,1,num_conti,i)= 0.0d0
2732 c a_chuj(2,2,num_conti,i)= 0.0d0
2734 C --- and its gradients
2735 cd write (iout,*) 'i',i,' j',j
2737 cd write (iout,*) 'iii 1 kkk',kkk
2738 cd write (iout,*) agg(kkk,:)
2741 cd write (iout,*) 'iii 2 kkk',kkk
2742 cd write (iout,*) aggi(kkk,:)
2745 cd write (iout,*) 'iii 3 kkk',kkk
2746 cd write (iout,*) aggi1(kkk,:)
2749 cd write (iout,*) 'iii 4 kkk',kkk
2750 cd write (iout,*) aggj(kkk,:)
2753 cd write (iout,*) 'iii 5 kkk',kkk
2754 cd write (iout,*) aggj1(kkk,:)
2761 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2762 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2763 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2764 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2765 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2767 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2773 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2774 C Calculate contact energies
2776 wij=cosa-3.0D0*cosb*cosg
2779 c fac3=dsqrt(-ael6i)/r0ij**3
2780 fac3=dsqrt(-ael6i)*r3ij
2781 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2782 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2783 if (shield_mode.eq.0) then
2787 ees0plist(num_conti,i)=j
2788 C fac_shield(i)=0.4d0
2789 C fac_shield(j)=0.6d0
2792 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2793 & *fac_shield(i)*fac_shield(j)
2795 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2796 & *fac_shield(i)*fac_shield(j)
2798 C Diagnostics. Comment out or remove after debugging!
2799 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2800 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2801 c ees0m(num_conti,i)=0.0D0
2803 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2804 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2805 facont_hb(num_conti,i)=fcont
2807 C Angular derivatives of the contact function
2808 ees0pij1=fac3/ees0pij
2809 ees0mij1=fac3/ees0mij
2810 fac3p=-3.0D0*fac3*rrmij
2811 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2812 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2814 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2815 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2816 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2817 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2818 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2819 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2820 ecosap=ecosa1+ecosa2
2821 ecosbp=ecosb1+ecosb2
2822 ecosgp=ecosg1+ecosg2
2823 ecosam=ecosa1-ecosa2
2824 ecosbm=ecosb1-ecosb2
2825 ecosgm=ecosg1-ecosg2
2834 fprimcont=fprimcont/rij
2835 cd facont_hb(num_conti,i)=1.0D0
2836 C Following line is for diagnostics.
2839 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2840 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2843 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2844 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2846 gggp(1)=gggp(1)+ees0pijp*xj
2847 gggp(2)=gggp(2)+ees0pijp*yj
2848 gggp(3)=gggp(3)+ees0pijp*zj
2849 gggm(1)=gggm(1)+ees0mijp*xj
2850 gggm(2)=gggm(2)+ees0mijp*yj
2851 gggm(3)=gggm(3)+ees0mijp*zj
2852 C Derivatives due to the contact function
2853 gacont_hbr(1,num_conti,i)=fprimcont*xj
2854 gacont_hbr(2,num_conti,i)=fprimcont*yj
2855 gacont_hbr(3,num_conti,i)=fprimcont*zj
2857 ghalfp=0.5D0*gggp(k)
2858 ghalfm=0.5D0*gggm(k)
2859 gacontp_hb1(k,num_conti,i)=ghalfp
2860 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2861 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2862 & *fac_shield(i)*fac_shield(j)
2864 gacontp_hb2(k,num_conti,i)=ghalfp
2865 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2866 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2867 & *fac_shield(i)*fac_shield(j)
2869 gacontp_hb3(k,num_conti,i)=gggp(k)
2870 & *fac_shield(i)*fac_shield(j)
2872 gacontm_hb1(k,num_conti,i)=ghalfm
2873 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2874 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2875 & *fac_shield(i)*fac_shield(j)
2877 gacontm_hb2(k,num_conti,i)=ghalfm
2878 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2879 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2880 & *fac_shield(i)*fac_shield(j)
2882 gacontm_hb3(k,num_conti,i)=gggm(k)
2883 & *fac_shield(i)*fac_shield(j)
2887 C Diagnostics. Comment out or remove after debugging!
2889 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2890 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2891 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2892 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2893 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2894 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2897 endif ! num_conti.le.maxconts
2902 num_cont_hb(i)=num_conti
2906 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2907 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2909 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2910 ccc eel_loc=eel_loc+eello_turn3
2913 C-----------------------------------------------------------------------------
2914 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2915 C Third- and fourth-order contributions from turns
2916 implicit real*8 (a-h,o-z)
2917 include 'DIMENSIONS'
2918 include 'sizesclu.dat'
2919 include 'COMMON.IOUNITS'
2920 include 'COMMON.GEO'
2921 include 'COMMON.VAR'
2922 include 'COMMON.LOCAL'
2923 include 'COMMON.CHAIN'
2924 include 'COMMON.DERIV'
2925 include 'COMMON.INTERACT'
2926 include 'COMMON.CONTACTS'
2927 include 'COMMON.TORSION'
2928 include 'COMMON.VECTORS'
2929 include 'COMMON.FFIELD'
2930 include 'COMMON.SHIELD'
2933 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2934 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2935 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2936 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2937 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2938 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2940 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2941 C changes suggested by Ana to avoid out of bounds
2942 C & .or.((i+5).gt.nres)
2943 C & .or.((i-1).le.0)
2944 C end of changes suggested by Ana
2945 & .or. itype(i+2).eq.ntyp1
2946 & .or. itype(i+3).eq.ntyp1
2947 C & .or. itype(i+5).eq.ntyp1
2948 C & .or. itype(i).eq.ntyp1
2949 C & .or. itype(i-1).eq.ntyp1
2952 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2954 C Third-order contributions
2961 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2962 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2963 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2964 call transpose2(auxmat(1,1),auxmat1(1,1))
2965 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2966 if (shield_mode.eq.0) then
2973 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2974 & *fac_shield(i)*fac_shield(j)
2975 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
2976 & *fac_shield(i)*fac_shield(j)
2978 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2979 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2980 cd & ' eello_turn3_num',4*eello_turn3_num
2982 C Derivatives in shield mode
2983 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2984 & (shield_mode.gt.0)) then
2987 do ilist=1,ishield_list(i)
2988 iresshield=shield_list(ilist,i)
2990 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
2992 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
2994 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
2995 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
2999 do ilist=1,ishield_list(j)
3000 iresshield=shield_list(ilist,j)
3002 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3004 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3006 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3007 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3014 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3015 & grad_shield(k,i)*eello_t3/fac_shield(i)
3016 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3017 & grad_shield(k,j)*eello_t3/fac_shield(j)
3018 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3019 & grad_shield(k,i)*eello_t3/fac_shield(i)
3020 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3021 & grad_shield(k,j)*eello_t3/fac_shield(j)
3025 C Derivatives in gamma(i)
3026 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3027 call transpose2(auxmat2(1,1),pizda(1,1))
3028 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3029 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3030 & *fac_shield(i)*fac_shield(j)
3032 C Derivatives in gamma(i+1)
3033 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3034 call transpose2(auxmat2(1,1),pizda(1,1))
3035 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3036 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3037 & +0.5d0*(pizda(1,1)+pizda(2,2))
3038 & *fac_shield(i)*fac_shield(j)
3040 C Cartesian derivatives
3042 a_temp(1,1)=aggi(l,1)
3043 a_temp(1,2)=aggi(l,2)
3044 a_temp(2,1)=aggi(l,3)
3045 a_temp(2,2)=aggi(l,4)
3046 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3047 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3048 & +0.5d0*(pizda(1,1)+pizda(2,2))
3049 & *fac_shield(i)*fac_shield(j)
3051 a_temp(1,1)=aggi1(l,1)
3052 a_temp(1,2)=aggi1(l,2)
3053 a_temp(2,1)=aggi1(l,3)
3054 a_temp(2,2)=aggi1(l,4)
3055 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3056 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3057 & +0.5d0*(pizda(1,1)+pizda(2,2))
3058 & *fac_shield(i)*fac_shield(j)
3060 a_temp(1,1)=aggj(l,1)
3061 a_temp(1,2)=aggj(l,2)
3062 a_temp(2,1)=aggj(l,3)
3063 a_temp(2,2)=aggj(l,4)
3064 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3065 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3066 & +0.5d0*(pizda(1,1)+pizda(2,2))
3067 & *fac_shield(i)*fac_shield(j)
3069 a_temp(1,1)=aggj1(l,1)
3070 a_temp(1,2)=aggj1(l,2)
3071 a_temp(2,1)=aggj1(l,3)
3072 a_temp(2,2)=aggj1(l,4)
3073 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3074 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3075 & +0.5d0*(pizda(1,1)+pizda(2,2))
3076 & *fac_shield(i)*fac_shield(j)
3081 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3082 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3083 C changes suggested by Ana to avoid out of bounds
3084 C & .or.((i+5).gt.nres)
3085 C & .or.((i-1).le.0)
3086 C end of changes suggested by Ana
3087 & .or. itype(i+3).eq.ntyp1
3088 & .or. itype(i+4).eq.ntyp1
3089 C & .or. itype(i+5).eq.ntyp1
3090 & .or. itype(i).eq.ntyp1
3091 C & .or. itype(i-1).eq.ntyp1
3094 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3096 C Fourth-order contributions
3104 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3105 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3106 iti1=itortyp(itype(i+1))
3107 iti2=itortyp(itype(i+2))
3108 iti3=itortyp(itype(i+3))
3109 call transpose2(EUg(1,1,i+1),e1t(1,1))
3110 call transpose2(Eug(1,1,i+2),e2t(1,1))
3111 call transpose2(Eug(1,1,i+3),e3t(1,1))
3112 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3113 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3114 s1=scalar2(b1(1,iti2),auxvec(1))
3115 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3116 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3117 s2=scalar2(b1(1,iti1),auxvec(1))
3118 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3119 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3120 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3121 if (shield_mode.eq.0) then
3128 eello_turn4=eello_turn4-(s1+s2+s3)
3129 & *fac_shield(i)*fac_shield(j)
3130 eello_t4=-(s1+s2+s3)
3131 & *fac_shield(i)*fac_shield(j)
3133 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3134 cd & ' eello_turn4_num',8*eello_turn4_num
3135 C Derivatives in gamma(i)
3137 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3138 & (shield_mode.gt.0)) then
3141 do ilist=1,ishield_list(i)
3142 iresshield=shield_list(ilist,i)
3144 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3146 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3148 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3149 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3153 do ilist=1,ishield_list(j)
3154 iresshield=shield_list(ilist,j)
3156 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3158 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3160 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3161 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3168 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3169 & grad_shield(k,i)*eello_t4/fac_shield(i)
3170 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3171 & grad_shield(k,j)*eello_t4/fac_shield(j)
3172 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3173 & grad_shield(k,i)*eello_t4/fac_shield(i)
3174 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3175 & grad_shield(k,j)*eello_t4/fac_shield(j)
3179 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3180 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3181 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3182 s1=scalar2(b1(1,iti2),auxvec(1))
3183 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3184 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3185 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3186 & *fac_shield(i)*fac_shield(j)
3188 C Derivatives in gamma(i+1)
3189 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3190 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3191 s2=scalar2(b1(1,iti1),auxvec(1))
3192 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3193 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3194 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3195 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3196 & *fac_shield(i)*fac_shield(j)
3198 C Derivatives in gamma(i+2)
3199 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3200 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3201 s1=scalar2(b1(1,iti2),auxvec(1))
3202 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3203 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3204 s2=scalar2(b1(1,iti1),auxvec(1))
3205 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3206 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3207 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3208 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3209 & *fac_shield(i)*fac_shield(j)
3211 C Cartesian derivatives
3212 C Derivatives of this turn contributions in DC(i+2)
3213 if (j.lt.nres-1) then
3215 a_temp(1,1)=agg(l,1)
3216 a_temp(1,2)=agg(l,2)
3217 a_temp(2,1)=agg(l,3)
3218 a_temp(2,2)=agg(l,4)
3219 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3220 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3221 s1=scalar2(b1(1,iti2),auxvec(1))
3222 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3223 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3224 s2=scalar2(b1(1,iti1),auxvec(1))
3225 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3226 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3227 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3229 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3230 & *fac_shield(i)*fac_shield(j)
3234 C Remaining derivatives of this turn contribution
3236 a_temp(1,1)=aggi(l,1)
3237 a_temp(1,2)=aggi(l,2)
3238 a_temp(2,1)=aggi(l,3)
3239 a_temp(2,2)=aggi(l,4)
3240 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3241 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3242 s1=scalar2(b1(1,iti2),auxvec(1))
3243 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3244 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3245 s2=scalar2(b1(1,iti1),auxvec(1))
3246 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3247 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3248 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3249 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3250 & *fac_shield(i)*fac_shield(j)
3252 a_temp(1,1)=aggi1(l,1)
3253 a_temp(1,2)=aggi1(l,2)
3254 a_temp(2,1)=aggi1(l,3)
3255 a_temp(2,2)=aggi1(l,4)
3256 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3257 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3258 s1=scalar2(b1(1,iti2),auxvec(1))
3259 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3260 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3261 s2=scalar2(b1(1,iti1),auxvec(1))
3262 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3263 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3264 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3265 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3266 & *fac_shield(i)*fac_shield(j)
3268 a_temp(1,1)=aggj(l,1)
3269 a_temp(1,2)=aggj(l,2)
3270 a_temp(2,1)=aggj(l,3)
3271 a_temp(2,2)=aggj(l,4)
3272 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3273 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3274 s1=scalar2(b1(1,iti2),auxvec(1))
3275 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3276 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3277 s2=scalar2(b1(1,iti1),auxvec(1))
3278 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3279 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3280 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3281 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3282 & *fac_shield(i)*fac_shield(j)
3284 a_temp(1,1)=aggj1(l,1)
3285 a_temp(1,2)=aggj1(l,2)
3286 a_temp(2,1)=aggj1(l,3)
3287 a_temp(2,2)=aggj1(l,4)
3288 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3289 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3290 s1=scalar2(b1(1,iti2),auxvec(1))
3291 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3292 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3293 s2=scalar2(b1(1,iti1),auxvec(1))
3294 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3295 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3296 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3297 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3298 & *fac_shield(i)*fac_shield(j)
3306 C-----------------------------------------------------------------------------
3307 subroutine vecpr(u,v,w)
3308 implicit real*8(a-h,o-z)
3309 dimension u(3),v(3),w(3)
3310 w(1)=u(2)*v(3)-u(3)*v(2)
3311 w(2)=-u(1)*v(3)+u(3)*v(1)
3312 w(3)=u(1)*v(2)-u(2)*v(1)
3315 C-----------------------------------------------------------------------------
3316 subroutine unormderiv(u,ugrad,unorm,ungrad)
3317 C This subroutine computes the derivatives of a normalized vector u, given
3318 C the derivatives computed without normalization conditions, ugrad. Returns
3321 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3322 double precision vec(3)
3323 double precision scalar
3325 c write (2,*) 'ugrad',ugrad
3328 vec(i)=scalar(ugrad(1,i),u(1))
3330 c write (2,*) 'vec',vec
3333 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3336 c write (2,*) 'ungrad',ungrad
3339 C-----------------------------------------------------------------------------
3340 subroutine escp(evdw2,evdw2_14)
3342 C This subroutine calculates the excluded-volume interaction energy between
3343 C peptide-group centers and side chains and its gradient in virtual-bond and
3344 C side-chain vectors.
3346 implicit real*8 (a-h,o-z)
3347 include 'DIMENSIONS'
3348 include 'sizesclu.dat'
3349 include 'COMMON.GEO'
3350 include 'COMMON.VAR'
3351 include 'COMMON.LOCAL'
3352 include 'COMMON.CHAIN'
3353 include 'COMMON.DERIV'
3354 include 'COMMON.INTERACT'
3355 include 'COMMON.FFIELD'
3356 include 'COMMON.IOUNITS'
3360 cd print '(a)','Enter ESCP'
3361 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3362 c & ' scal14',scal14
3363 do i=iatscp_s,iatscp_e
3364 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3366 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3367 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3368 if (iteli.eq.0) goto 1225
3369 xi=0.5D0*(c(1,i)+c(1,i+1))
3370 yi=0.5D0*(c(2,i)+c(2,i+1))
3371 zi=0.5D0*(c(3,i)+c(3,i+1))
3372 C Returning the ith atom to box
3374 if (xi.lt.0) xi=xi+boxxsize
3376 if (yi.lt.0) yi=yi+boxysize
3378 if (zi.lt.0) zi=zi+boxzsize
3380 do iint=1,nscp_gr(i)
3382 do j=iscpstart(i,iint),iscpend(i,iint)
3383 itypj=iabs(itype(j))
3384 if (itypj.eq.ntyp1) cycle
3385 C Uncomment following three lines for SC-p interactions
3389 C Uncomment following three lines for Ca-p interactions
3393 C returning the jth atom to box
3395 if (xj.lt.0) xj=xj+boxxsize
3397 if (yj.lt.0) yj=yj+boxysize
3399 if (zj.lt.0) zj=zj+boxzsize
3400 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3405 C Finding the closest jth atom
3409 xj=xj_safe+xshift*boxxsize
3410 yj=yj_safe+yshift*boxysize
3411 zj=zj_safe+zshift*boxzsize
3412 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3413 if(dist_temp.lt.dist_init) then
3423 if (subchap.eq.1) then
3433 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3434 C sss is scaling function for smoothing the cutoff gradient otherwise
3435 C the gradient would not be continuouse
3436 sss=sscale(1.0d0/(dsqrt(rrij)))
3437 if (sss.le.0.0d0) cycle
3438 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3440 e1=fac*fac*aad(itypj,iteli)
3441 e2=fac*bad(itypj,iteli)
3442 if (iabs(j-i) .le. 2) then
3445 evdw2_14=evdw2_14+(e1+e2)*sss
3448 c write (iout,*) i,j,evdwij
3449 evdw2=evdw2+evdwij*sss
3452 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3454 fac=-(evdwij+e1)*rrij*sss
3455 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3460 cd write (iout,*) 'j<i'
3461 C Uncomment following three lines for SC-p interactions
3463 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3466 cd write (iout,*) 'j>i'
3469 C Uncomment following line for SC-p interactions
3470 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3474 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3478 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3479 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3482 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3492 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3493 gradx_scp(j,i)=expon*gradx_scp(j,i)
3496 C******************************************************************************
3500 C To save time the factor EXPON has been extracted from ALL components
3501 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3504 C******************************************************************************
3507 C--------------------------------------------------------------------------
3508 subroutine edis(ehpb)
3510 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3512 implicit real*8 (a-h,o-z)
3513 include 'DIMENSIONS'
3514 include 'sizesclu.dat'
3515 include 'COMMON.SBRIDGE'
3516 include 'COMMON.CHAIN'
3517 include 'COMMON.DERIV'
3518 include 'COMMON.VAR'
3519 include 'COMMON.INTERACT'
3520 include 'COMMON.CONTROL'
3523 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3524 cd print *,'link_start=',link_start,' link_end=',link_end
3525 if (link_end.eq.0) return
3526 do i=link_start,link_end
3527 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3528 C CA-CA distance used in regularization of structure.
3531 C iii and jjj point to the residues for which the distance is assigned.
3532 if (ii.gt.nres) then
3539 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3540 C distance and angle dependent SS bond potential.
3541 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3542 C & iabs(itype(jjj)).eq.1) then
3543 C call ssbond_ene(iii,jjj,eij)
3546 if (.not.dyn_ss .and. i.le.nss) then
3547 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3548 & iabs(itype(jjj)).eq.1) then
3549 call ssbond_ene(iii,jjj,eij)
3552 else if (ii.gt.nres .and. jj.gt.nres) then
3553 c Restraints from contact prediction
3555 if (constr_dist.eq.11) then
3556 C ehpb=ehpb+fordepth(i)**4.0d0
3557 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3558 ehpb=ehpb+fordepth(i)**4.0d0
3559 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3560 fac=fordepth(i)**4.0d0
3561 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3562 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3563 C & ehpb,fordepth(i),dd
3565 C write(iout,*) ehpb,"atu?"
3567 C fac=fordepth(i)**4.0d0
3568 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3569 else !constr_dist.eq.11
3570 if (dhpb1(i).gt.0.0d0) then
3571 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3572 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3573 c write (iout,*) "beta nmr",
3574 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3575 else !dhpb(i).gt.0.00
3577 C Calculate the distance between the two points and its difference from the
3581 C Get the force constant corresponding to this distance.
3583 C Calculate the contribution to energy.
3584 ehpb=ehpb+waga*rdis*rdis
3586 C Evaluate gradient.
3591 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3592 cd & ' waga=',waga,' fac=',fac
3594 ggg(j)=fac*(c(j,jj)-c(j,ii))
3596 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3597 C If this is a SC-SC distance, we need to calculate the contributions to the
3598 C Cartesian gradient in the SC vectors (ghpbx).
3601 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3602 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3606 C write(iout,*) "before"
3608 C write(iout,*) "after",dd
3609 if (constr_dist.eq.11) then
3610 ehpb=ehpb+fordepth(i)**4.0d0
3611 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3612 fac=fordepth(i)**4.0d0
3613 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3614 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3615 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3616 C print *,ehpb,"tu?"
3617 C write(iout,*) ehpb,"btu?",
3618 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3619 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3620 C & ehpb,fordepth(i),dd
3622 if (dhpb1(i).gt.0.0d0) then
3623 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3624 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3625 c write (iout,*) "alph nmr",
3626 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3629 C Get the force constant corresponding to this distance.
3631 C Calculate the contribution to energy.
3632 ehpb=ehpb+waga*rdis*rdis
3633 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3635 C Evaluate gradient.
3641 ggg(j)=fac*(c(j,jj)-c(j,ii))
3643 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3644 C If this is a SC-SC distance, we need to calculate the contributions to the
3645 C Cartesian gradient in the SC vectors (ghpbx).
3648 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3649 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3654 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3659 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3662 C--------------------------------------------------------------------------
3663 subroutine ssbond_ene(i,j,eij)
3665 C Calculate the distance and angle dependent SS-bond potential energy
3666 C using a free-energy function derived based on RHF/6-31G** ab initio
3667 C calculations of diethyl disulfide.
3669 C A. Liwo and U. Kozlowska, 11/24/03
3671 implicit real*8 (a-h,o-z)
3672 include 'DIMENSIONS'
3673 include 'sizesclu.dat'
3674 include 'COMMON.SBRIDGE'
3675 include 'COMMON.CHAIN'
3676 include 'COMMON.DERIV'
3677 include 'COMMON.LOCAL'
3678 include 'COMMON.INTERACT'
3679 include 'COMMON.VAR'
3680 include 'COMMON.IOUNITS'
3681 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3682 itypi=iabs(itype(i))
3686 dxi=dc_norm(1,nres+i)
3687 dyi=dc_norm(2,nres+i)
3688 dzi=dc_norm(3,nres+i)
3689 dsci_inv=dsc_inv(itypi)
3690 itypj=iabs(itype(j))
3691 dscj_inv=dsc_inv(itypj)
3695 dxj=dc_norm(1,nres+j)
3696 dyj=dc_norm(2,nres+j)
3697 dzj=dc_norm(3,nres+j)
3698 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3703 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3704 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3705 om12=dxi*dxj+dyi*dyj+dzi*dzj
3707 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3708 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3714 deltat12=om2-om1+2.0d0
3716 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3717 & +akct*deltad*deltat12
3718 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3719 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3720 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3721 c & " deltat12",deltat12," eij",eij
3722 ed=2*akcm*deltad+akct*deltat12
3724 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3725 eom1=-2*akth*deltat1-pom1-om2*pom2
3726 eom2= 2*akth*deltat2+pom1-om1*pom2
3729 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3732 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3733 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3734 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3735 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3738 C Calculate the components of the gradient in DC and X
3742 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3747 C--------------------------------------------------------------------------
3748 subroutine ebond(estr)
3750 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3752 implicit real*8 (a-h,o-z)
3753 include 'DIMENSIONS'
3754 include 'sizesclu.dat'
3755 include 'COMMON.LOCAL'
3756 include 'COMMON.GEO'
3757 include 'COMMON.INTERACT'
3758 include 'COMMON.DERIV'
3759 include 'COMMON.VAR'
3760 include 'COMMON.CHAIN'
3761 include 'COMMON.IOUNITS'
3762 include 'COMMON.NAMES'
3763 include 'COMMON.FFIELD'
3764 include 'COMMON.CONTROL'
3765 logical energy_dec /.false./
3766 double precision u(3),ud(3)
3770 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3771 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3773 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3774 C & *dc(j,i-1)/vbld(i)
3776 C if (energy_dec) write(iout,*)
3777 C & "estr1",i,vbld(i),distchainmax,
3778 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3780 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3781 diff = vbld(i)-vbldpDUM
3783 diff = vbld(i)-vbldp0
3784 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3788 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3791 C write (iout,'(a7,i5,4f7.3)')
3792 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3794 estr=0.5d0*AKP*estr+estr1
3796 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3800 if (iti.ne.10 .and. iti.ne.ntyp1) then
3803 diff=vbld(i+nres)-vbldsc0(1,iti)
3804 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3805 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3806 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3808 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3812 diff=vbld(i+nres)-vbldsc0(j,iti)
3813 ud(j)=aksc(j,iti)*diff
3814 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3828 uprod2=uprod2*u(k)*u(k)
3832 usumsqder=usumsqder+ud(j)*uprod2
3834 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3835 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3836 estr=estr+uprod/usum
3838 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3846 C--------------------------------------------------------------------------
3847 subroutine ebend(etheta,ethetacnstr)
3849 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3850 C angles gamma and its derivatives in consecutive thetas and gammas.
3852 implicit real*8 (a-h,o-z)
3853 include 'DIMENSIONS'
3854 include 'sizesclu.dat'
3855 include 'COMMON.LOCAL'
3856 include 'COMMON.GEO'
3857 include 'COMMON.INTERACT'
3858 include 'COMMON.DERIV'
3859 include 'COMMON.VAR'
3860 include 'COMMON.CHAIN'
3861 include 'COMMON.IOUNITS'
3862 include 'COMMON.NAMES'
3863 include 'COMMON.FFIELD'
3864 include 'COMMON.TORCNSTR'
3865 common /calcthet/ term1,term2,termm,diffak,ratak,
3866 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3867 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3868 double precision y(2),z(2)
3870 c time11=dexp(-2*time)
3873 c write (iout,*) "nres",nres
3874 c write (*,'(a,i2)') 'EBEND ICG=',icg
3875 c write (iout,*) ithet_start,ithet_end
3876 do i=ithet_start,ithet_end
3878 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3879 & .or.itype(i).eq.ntyp1) cycle
3880 C Zero the energy function and its derivative at 0 or pi.
3881 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3883 ichir1=isign(1,itype(i-2))
3884 ichir2=isign(1,itype(i))
3885 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3886 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3887 if (itype(i-1).eq.10) then
3888 itype1=isign(10,itype(i-2))
3889 ichir11=isign(1,itype(i-2))
3890 ichir12=isign(1,itype(i-2))
3891 itype2=isign(10,itype(i))
3892 ichir21=isign(1,itype(i))
3893 ichir22=isign(1,itype(i))
3899 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3903 c call proc_proc(phii,icrc)
3904 if (icrc.eq.1) phii=150.0
3915 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3919 c call proc_proc(phii1,icrc)
3920 if (icrc.eq.1) phii1=150.0
3932 C Calculate the "mean" value of theta from the part of the distribution
3933 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3934 C In following comments this theta will be referred to as t_c.
3935 thet_pred_mean=0.0d0
3937 athetk=athet(k,it,ichir1,ichir2)
3938 bthetk=bthet(k,it,ichir1,ichir2)
3940 athetk=athet(k,itype1,ichir11,ichir12)
3941 bthetk=bthet(k,itype2,ichir21,ichir22)
3943 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3945 c write (iout,*) "thet_pred_mean",thet_pred_mean
3946 dthett=thet_pred_mean*ssd
3947 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3948 c write (iout,*) "thet_pred_mean",thet_pred_mean
3949 C Derivatives of the "mean" values in gamma1 and gamma2.
3950 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3951 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3952 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3953 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3955 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3956 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3957 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3958 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3960 if (theta(i).gt.pi-delta) then
3961 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3963 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3964 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3965 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3967 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3969 else if (theta(i).lt.delta) then
3970 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3971 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3972 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3974 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3975 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3978 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3981 etheta=etheta+ethetai
3982 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3983 c & rad2deg*phii,rad2deg*phii1,ethetai
3984 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3985 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3986 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3989 C Ufff.... We've done all this!!!
3992 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
3993 do i=1,ntheta_constr
3994 itheta=itheta_constr(i)
3995 thetiii=theta(itheta)
3996 difi=pinorm(thetiii-theta_constr0(i))
3997 if (difi.gt.theta_drange(i)) then
3998 difi=difi-theta_drange(i)
3999 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4000 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4001 & +for_thet_constr(i)*difi**3
4002 else if (difi.lt.-drange(i)) then
4004 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4005 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4006 & +for_thet_constr(i)*difi**3
4010 C if (energy_dec) then
4011 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4012 C & i,itheta,rad2deg*thetiii,
4013 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4014 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4015 C & gloc(itheta+nphi-2,icg)
4020 C---------------------------------------------------------------------------
4021 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4023 implicit real*8 (a-h,o-z)
4024 include 'DIMENSIONS'
4025 include 'COMMON.LOCAL'
4026 include 'COMMON.IOUNITS'
4027 common /calcthet/ term1,term2,termm,diffak,ratak,
4028 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4029 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4030 C Calculate the contributions to both Gaussian lobes.
4031 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4032 C The "polynomial part" of the "standard deviation" of this part of
4036 sig=sig*thet_pred_mean+polthet(j,it)
4038 C Derivative of the "interior part" of the "standard deviation of the"
4039 C gamma-dependent Gaussian lobe in t_c.
4040 sigtc=3*polthet(3,it)
4042 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4045 C Set the parameters of both Gaussian lobes of the distribution.
4046 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4047 fac=sig*sig+sigc0(it)
4050 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4051 sigsqtc=-4.0D0*sigcsq*sigtc
4052 c print *,i,sig,sigtc,sigsqtc
4053 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4054 sigtc=-sigtc/(fac*fac)
4055 C Following variable is sigma(t_c)**(-2)
4056 sigcsq=sigcsq*sigcsq
4058 sig0inv=1.0D0/sig0i**2
4059 delthec=thetai-thet_pred_mean
4060 delthe0=thetai-theta0i
4061 term1=-0.5D0*sigcsq*delthec*delthec
4062 term2=-0.5D0*sig0inv*delthe0*delthe0
4063 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4064 C NaNs in taking the logarithm. We extract the largest exponent which is added
4065 C to the energy (this being the log of the distribution) at the end of energy
4066 C term evaluation for this virtual-bond angle.
4067 if (term1.gt.term2) then
4069 term2=dexp(term2-termm)
4073 term1=dexp(term1-termm)
4076 C The ratio between the gamma-independent and gamma-dependent lobes of
4077 C the distribution is a Gaussian function of thet_pred_mean too.
4078 diffak=gthet(2,it)-thet_pred_mean
4079 ratak=diffak/gthet(3,it)**2
4080 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4081 C Let's differentiate it in thet_pred_mean NOW.
4083 C Now put together the distribution terms to make complete distribution.
4084 termexp=term1+ak*term2
4085 termpre=sigc+ak*sig0i
4086 C Contribution of the bending energy from this theta is just the -log of
4087 C the sum of the contributions from the two lobes and the pre-exponential
4088 C factor. Simple enough, isn't it?
4089 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4090 C NOW the derivatives!!!
4091 C 6/6/97 Take into account the deformation.
4092 E_theta=(delthec*sigcsq*term1
4093 & +ak*delthe0*sig0inv*term2)/termexp
4094 E_tc=((sigtc+aktc*sig0i)/termpre
4095 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4096 & aktc*term2)/termexp)
4099 c-----------------------------------------------------------------------------
4100 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4101 implicit real*8 (a-h,o-z)
4102 include 'DIMENSIONS'
4103 include 'COMMON.LOCAL'
4104 include 'COMMON.IOUNITS'
4105 common /calcthet/ term1,term2,termm,diffak,ratak,
4106 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4107 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4108 delthec=thetai-thet_pred_mean
4109 delthe0=thetai-theta0i
4110 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4111 t3 = thetai-thet_pred_mean
4115 t14 = t12+t6*sigsqtc
4117 t21 = thetai-theta0i
4123 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4124 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4125 & *(-t12*t9-ak*sig0inv*t27)
4129 C--------------------------------------------------------------------------
4130 subroutine ebend(etheta,ethetacnstr)
4132 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4133 C angles gamma and its derivatives in consecutive thetas and gammas.
4134 C ab initio-derived potentials from
4135 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4137 implicit real*8 (a-h,o-z)
4138 include 'DIMENSIONS'
4139 include 'sizesclu.dat'
4140 include 'COMMON.LOCAL'
4141 include 'COMMON.GEO'
4142 include 'COMMON.INTERACT'
4143 include 'COMMON.DERIV'
4144 include 'COMMON.VAR'
4145 include 'COMMON.CHAIN'
4146 include 'COMMON.IOUNITS'
4147 include 'COMMON.NAMES'
4148 include 'COMMON.FFIELD'
4149 include 'COMMON.CONTROL'
4150 include 'COMMON.TORCNSTR'
4151 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4152 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4153 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4154 & sinph1ph2(maxdouble,maxdouble)
4155 logical lprn /.false./, lprn1 /.false./
4157 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4158 do i=ithet_start,ithet_end
4160 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4161 & .or.itype(i).eq.ntyp1) cycle
4162 c if (itype(i-1).eq.ntyp1) cycle
4163 if (iabs(itype(i+1)).eq.20) iblock=2
4164 if (iabs(itype(i+1)).ne.20) iblock=1
4168 theti2=0.5d0*theta(i)
4169 ityp2=ithetyp((itype(i-1)))
4171 coskt(k)=dcos(k*theti2)
4172 sinkt(k)=dsin(k*theti2)
4182 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4185 if (phii.ne.phii) phii=150.0
4189 ityp1=ithetyp((itype(i-2)))
4191 cosph1(k)=dcos(k*phii)
4192 sinph1(k)=dsin(k*phii)
4198 ityp1=ithetyp((itype(i-2)))
4204 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4207 if (phii1.ne.phii1) phii1=150.0
4212 ityp3=ithetyp((itype(i)))
4214 cosph2(k)=dcos(k*phii1)
4215 sinph2(k)=dsin(k*phii1)
4220 ityp3=ithetyp((itype(i)))
4226 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4227 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4229 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4232 ccl=cosph1(l)*cosph2(k-l)
4233 ssl=sinph1(l)*sinph2(k-l)
4234 scl=sinph1(l)*cosph2(k-l)
4235 csl=cosph1(l)*sinph2(k-l)
4236 cosph1ph2(l,k)=ccl-ssl
4237 cosph1ph2(k,l)=ccl+ssl
4238 sinph1ph2(l,k)=scl+csl
4239 sinph1ph2(k,l)=scl-csl
4243 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4244 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4245 write (iout,*) "coskt and sinkt"
4247 write (iout,*) k,coskt(k),sinkt(k)
4251 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4252 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4255 & write (iout,*) "k",k," aathet",
4256 & aathet(k,ityp1,ityp2,ityp3,iblock),
4257 & " ethetai",ethetai
4260 write (iout,*) "cosph and sinph"
4262 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4264 write (iout,*) "cosph1ph2 and sinph2ph2"
4267 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4268 & sinph1ph2(l,k),sinph1ph2(k,l)
4271 write(iout,*) "ethetai",ethetai
4275 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4276 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4277 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4278 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4279 ethetai=ethetai+sinkt(m)*aux
4280 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4281 dephii=dephii+k*sinkt(m)*(
4282 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4283 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4284 dephii1=dephii1+k*sinkt(m)*(
4285 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4286 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4288 & write (iout,*) "m",m," k",k," bbthet",
4289 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4290 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4291 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4292 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4296 & write(iout,*) "ethetai",ethetai
4300 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4301 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4302 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4303 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4304 ethetai=ethetai+sinkt(m)*aux
4305 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4306 dephii=dephii+l*sinkt(m)*(
4307 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4308 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4309 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4310 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4311 dephii1=dephii1+(k-l)*sinkt(m)*(
4312 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4313 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4314 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4315 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4317 write (iout,*) "m",m," k",k," l",l," ffthet",
4318 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4319 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4320 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4321 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4322 & " ethetai",ethetai
4323 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4324 & cosph1ph2(k,l)*sinkt(m),
4325 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4331 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4332 & i,theta(i)*rad2deg,phii*rad2deg,
4333 & phii1*rad2deg,ethetai
4334 etheta=etheta+ethetai
4335 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4336 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4337 c gloc(nphi+i-2,icg)=wang*dethetai
4338 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4342 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4343 do i=1,ntheta_constr
4344 itheta=itheta_constr(i)
4345 thetiii=theta(itheta)
4346 difi=pinorm(thetiii-theta_constr0(i))
4347 if (difi.gt.theta_drange(i)) then
4348 difi=difi-theta_drange(i)
4349 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4350 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4351 & +for_thet_constr(i)*difi**3
4352 else if (difi.lt.-drange(i)) then
4354 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4355 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4356 & +for_thet_constr(i)*difi**3
4360 C if (energy_dec) then
4361 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4362 C & i,itheta,rad2deg*thetiii,
4363 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4364 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4365 C & gloc(itheta+nphi-2,icg)
4372 c-----------------------------------------------------------------------------
4373 subroutine esc(escloc)
4374 C Calculate the local energy of a side chain and its derivatives in the
4375 C corresponding virtual-bond valence angles THETA and the spherical angles
4377 implicit real*8 (a-h,o-z)
4378 include 'DIMENSIONS'
4379 include 'sizesclu.dat'
4380 include 'COMMON.GEO'
4381 include 'COMMON.LOCAL'
4382 include 'COMMON.VAR'
4383 include 'COMMON.INTERACT'
4384 include 'COMMON.DERIV'
4385 include 'COMMON.CHAIN'
4386 include 'COMMON.IOUNITS'
4387 include 'COMMON.NAMES'
4388 include 'COMMON.FFIELD'
4389 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4390 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4391 common /sccalc/ time11,time12,time112,theti,it,nlobit
4394 c write (iout,'(a)') 'ESC'
4395 do i=loc_start,loc_end
4397 if (it.eq.ntyp1) cycle
4398 if (it.eq.10) goto 1
4399 nlobit=nlob(iabs(it))
4400 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4401 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4402 theti=theta(i+1)-pipol
4406 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4408 if (x(2).gt.pi-delta) then
4412 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4414 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4415 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4417 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4418 & ddersc0(1),dersc(1))
4419 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4420 & ddersc0(3),dersc(3))
4422 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4424 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4425 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4426 & dersc0(2),esclocbi,dersc02)
4427 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4429 call splinthet(x(2),0.5d0*delta,ss,ssd)
4434 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4436 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4437 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4439 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4441 c write (iout,*) escloci
4442 else if (x(2).lt.delta) then
4446 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4448 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4449 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4451 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4452 & ddersc0(1),dersc(1))
4453 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4454 & ddersc0(3),dersc(3))
4456 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4458 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4459 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4460 & dersc0(2),esclocbi,dersc02)
4461 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4466 call splinthet(x(2),0.5d0*delta,ss,ssd)
4468 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4470 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4471 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4473 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4474 c write (iout,*) escloci
4476 call enesc(x,escloci,dersc,ddummy,.false.)
4479 escloc=escloc+escloci
4480 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4482 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4484 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4485 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4490 C---------------------------------------------------------------------------
4491 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4492 implicit real*8 (a-h,o-z)
4493 include 'DIMENSIONS'
4494 include 'COMMON.GEO'
4495 include 'COMMON.LOCAL'
4496 include 'COMMON.IOUNITS'
4497 common /sccalc/ time11,time12,time112,theti,it,nlobit
4498 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4499 double precision contr(maxlob,-1:1)
4501 c write (iout,*) 'it=',it,' nlobit=',nlobit
4505 if (mixed) ddersc(j)=0.0d0
4509 C Because of periodicity of the dependence of the SC energy in omega we have
4510 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4511 C To avoid underflows, first compute & store the exponents.
4519 z(k)=x(k)-censc(k,j,it)
4524 Axk=Axk+gaussc(l,k,j,it)*z(l)
4530 expfac=expfac+Ax(k,j,iii)*z(k)
4538 C As in the case of ebend, we want to avoid underflows in exponentiation and
4539 C subsequent NaNs and INFs in energy calculation.
4540 C Find the largest exponent
4544 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4548 cd print *,'it=',it,' emin=',emin
4550 C Compute the contribution to SC energy and derivatives
4554 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4555 cd print *,'j=',j,' expfac=',expfac
4556 escloc_i=escloc_i+expfac
4558 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4562 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4563 & +gaussc(k,2,j,it))*expfac
4570 dersc(1)=dersc(1)/cos(theti)**2
4571 ddersc(1)=ddersc(1)/cos(theti)**2
4574 escloci=-(dlog(escloc_i)-emin)
4576 dersc(j)=dersc(j)/escloc_i
4580 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4585 C------------------------------------------------------------------------------
4586 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4587 implicit real*8 (a-h,o-z)
4588 include 'DIMENSIONS'
4589 include 'COMMON.GEO'
4590 include 'COMMON.LOCAL'
4591 include 'COMMON.IOUNITS'
4592 common /sccalc/ time11,time12,time112,theti,it,nlobit
4593 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4594 double precision contr(maxlob)
4605 z(k)=x(k)-censc(k,j,it)
4611 Axk=Axk+gaussc(l,k,j,it)*z(l)
4617 expfac=expfac+Ax(k,j)*z(k)
4622 C As in the case of ebend, we want to avoid underflows in exponentiation and
4623 C subsequent NaNs and INFs in energy calculation.
4624 C Find the largest exponent
4627 if (emin.gt.contr(j)) emin=contr(j)
4631 C Compute the contribution to SC energy and derivatives
4635 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4636 escloc_i=escloc_i+expfac
4638 dersc(k)=dersc(k)+Ax(k,j)*expfac
4640 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4641 & +gaussc(1,2,j,it))*expfac
4645 dersc(1)=dersc(1)/cos(theti)**2
4646 dersc12=dersc12/cos(theti)**2
4647 escloci=-(dlog(escloc_i)-emin)
4649 dersc(j)=dersc(j)/escloc_i
4651 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4655 c----------------------------------------------------------------------------------
4656 subroutine esc(escloc)
4657 C Calculate the local energy of a side chain and its derivatives in the
4658 C corresponding virtual-bond valence angles THETA and the spherical angles
4659 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4660 C added by Urszula Kozlowska. 07/11/2007
4662 implicit real*8 (a-h,o-z)
4663 include 'DIMENSIONS'
4664 include 'sizesclu.dat'
4665 include 'COMMON.GEO'
4666 include 'COMMON.LOCAL'
4667 include 'COMMON.VAR'
4668 include 'COMMON.SCROT'
4669 include 'COMMON.INTERACT'
4670 include 'COMMON.DERIV'
4671 include 'COMMON.CHAIN'
4672 include 'COMMON.IOUNITS'
4673 include 'COMMON.NAMES'
4674 include 'COMMON.FFIELD'
4675 include 'COMMON.CONTROL'
4676 include 'COMMON.VECTORS'
4677 double precision x_prime(3),y_prime(3),z_prime(3)
4678 & , sumene,dsc_i,dp2_i,x(65),
4679 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4680 & de_dxx,de_dyy,de_dzz,de_dt
4681 double precision s1_t,s1_6_t,s2_t,s2_6_t
4683 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4684 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4685 & dt_dCi(3),dt_dCi1(3)
4686 common /sccalc/ time11,time12,time112,theti,it,nlobit
4689 do i=loc_start,loc_end
4690 if (itype(i).eq.ntyp1) cycle
4691 costtab(i+1) =dcos(theta(i+1))
4692 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4693 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4694 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4695 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4696 cosfac=dsqrt(cosfac2)
4697 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4698 sinfac=dsqrt(sinfac2)
4700 if (it.eq.10) goto 1
4702 C Compute the axes of tghe local cartesian coordinates system; store in
4703 c x_prime, y_prime and z_prime
4710 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4711 C & dc_norm(3,i+nres)
4713 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4714 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4717 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4720 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4721 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4722 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4723 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4724 c & " xy",scalar(x_prime(1),y_prime(1)),
4725 c & " xz",scalar(x_prime(1),z_prime(1)),
4726 c & " yy",scalar(y_prime(1),y_prime(1)),
4727 c & " yz",scalar(y_prime(1),z_prime(1)),
4728 c & " zz",scalar(z_prime(1),z_prime(1))
4730 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4731 C to local coordinate system. Store in xx, yy, zz.
4737 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4738 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4739 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4746 C Compute the energy of the ith side cbain
4748 c write (2,*) "xx",xx," yy",yy," zz",zz
4751 x(j) = sc_parmin(j,it)
4754 Cc diagnostics - remove later
4756 yy1 = dsin(alph(2))*dcos(omeg(2))
4757 c zz1 = -dsin(alph(2))*dsin(omeg(2))
4758 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4759 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4760 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4762 C," --- ", xx_w,yy_w,zz_w
4765 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4766 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4768 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4769 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4771 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4772 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4773 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4774 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4775 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4777 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4778 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4779 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4780 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4781 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4783 dsc_i = 0.743d0+x(61)
4785 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4786 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4787 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4788 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4789 s1=(1+x(63))/(0.1d0 + dscp1)
4790 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4791 s2=(1+x(65))/(0.1d0 + dscp2)
4792 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4793 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4794 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4795 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4797 c & dscp1,dscp2,sumene
4798 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4799 escloc = escloc + sumene
4800 c write (2,*) "escloc",escloc
4801 if (.not. calc_grad) goto 1
4804 C This section to check the numerical derivatives of the energy of ith side
4805 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4806 C #define DEBUG in the code to turn it on.
4808 write (2,*) "sumene =",sumene
4812 write (2,*) xx,yy,zz
4813 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4814 de_dxx_num=(sumenep-sumene)/aincr
4816 write (2,*) "xx+ sumene from enesc=",sumenep
4819 write (2,*) xx,yy,zz
4820 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4821 de_dyy_num=(sumenep-sumene)/aincr
4823 write (2,*) "yy+ sumene from enesc=",sumenep
4826 write (2,*) xx,yy,zz
4827 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4828 de_dzz_num=(sumenep-sumene)/aincr
4830 write (2,*) "zz+ sumene from enesc=",sumenep
4831 costsave=cost2tab(i+1)
4832 sintsave=sint2tab(i+1)
4833 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4834 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4835 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4836 de_dt_num=(sumenep-sumene)/aincr
4837 write (2,*) " t+ sumene from enesc=",sumenep
4838 cost2tab(i+1)=costsave
4839 sint2tab(i+1)=sintsave
4840 C End of diagnostics section.
4843 C Compute the gradient of esc
4845 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4846 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4847 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4848 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4849 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4850 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4851 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4852 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4853 pom1=(sumene3*sint2tab(i+1)+sumene1)
4854 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4855 pom2=(sumene4*cost2tab(i+1)+sumene2)
4856 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4857 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4858 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4859 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4861 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4862 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4863 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4865 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4866 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4867 & +(pom1+pom2)*pom_dx
4869 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4872 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4873 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4874 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4876 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4877 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4878 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4879 & +x(59)*zz**2 +x(60)*xx*zz
4880 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4881 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4882 & +(pom1-pom2)*pom_dy
4884 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4887 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4888 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4889 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4890 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4891 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4892 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4893 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4894 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4896 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4899 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4900 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4901 & +pom1*pom_dt1+pom2*pom_dt2
4903 write(2,*), "de_dt = ", de_dt,de_dt_num
4907 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4908 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4909 cosfac2xx=cosfac2*xx
4910 sinfac2yy=sinfac2*yy
4912 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4914 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4916 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4917 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4918 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4919 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4920 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4921 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4922 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4923 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4924 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4925 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4929 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4930 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4931 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4932 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4935 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4936 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4937 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4939 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4940 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4944 dXX_Ctab(k,i)=dXX_Ci(k)
4945 dXX_C1tab(k,i)=dXX_Ci1(k)
4946 dYY_Ctab(k,i)=dYY_Ci(k)
4947 dYY_C1tab(k,i)=dYY_Ci1(k)
4948 dZZ_Ctab(k,i)=dZZ_Ci(k)
4949 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4950 dXX_XYZtab(k,i)=dXX_XYZ(k)
4951 dYY_XYZtab(k,i)=dYY_XYZ(k)
4952 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4956 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4957 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4958 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4959 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4960 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4962 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4963 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4964 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4965 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4966 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4967 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4968 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4969 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4971 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4972 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4974 C to check gradient call subroutine check_grad
4981 c------------------------------------------------------------------------------
4982 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4984 C This procedure calculates two-body contact function g(rij) and its derivative:
4987 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4990 C where x=(rij-r0ij)/delta
4992 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4995 double precision rij,r0ij,eps0ij,fcont,fprimcont
4996 double precision x,x2,x4,delta
5000 if (x.lt.-1.0D0) then
5003 else if (x.le.1.0D0) then
5006 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5007 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5014 c------------------------------------------------------------------------------
5015 subroutine splinthet(theti,delta,ss,ssder)
5016 implicit real*8 (a-h,o-z)
5017 include 'DIMENSIONS'
5018 include 'sizesclu.dat'
5019 include 'COMMON.VAR'
5020 include 'COMMON.GEO'
5023 if (theti.gt.pipol) then
5024 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5026 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5031 c------------------------------------------------------------------------------
5032 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5034 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5035 double precision ksi,ksi2,ksi3,a1,a2,a3
5036 a1=fprim0*delta/(f1-f0)
5042 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5043 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5046 c------------------------------------------------------------------------------
5047 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5049 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5050 double precision ksi,ksi2,ksi3,a1,a2,a3
5055 a2=3*(f1x-f0x)-2*fprim0x*delta
5056 a3=fprim0x*delta-2*(f1x-f0x)
5057 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5060 C-----------------------------------------------------------------------------
5062 C-----------------------------------------------------------------------------
5063 subroutine etor(etors,edihcnstr,fact)
5064 implicit real*8 (a-h,o-z)
5065 include 'DIMENSIONS'
5066 include 'sizesclu.dat'
5067 include 'COMMON.VAR'
5068 include 'COMMON.GEO'
5069 include 'COMMON.LOCAL'
5070 include 'COMMON.TORSION'
5071 include 'COMMON.INTERACT'
5072 include 'COMMON.DERIV'
5073 include 'COMMON.CHAIN'
5074 include 'COMMON.NAMES'
5075 include 'COMMON.IOUNITS'
5076 include 'COMMON.FFIELD'
5077 include 'COMMON.TORCNSTR'
5079 C Set lprn=.true. for debugging
5083 do i=iphi_start,iphi_end
5084 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5085 & .or. itype(i).eq.ntyp1) cycle
5086 itori=itortyp(itype(i-2))
5087 itori1=itortyp(itype(i-1))
5090 C Proline-Proline pair is a special case...
5091 if (itori.eq.3 .and. itori1.eq.3) then
5092 if (phii.gt.-dwapi3) then
5094 fac=1.0D0/(1.0D0-cosphi)
5095 etorsi=v1(1,3,3)*fac
5096 etorsi=etorsi+etorsi
5097 etors=etors+etorsi-v1(1,3,3)
5098 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5101 v1ij=v1(j+1,itori,itori1)
5102 v2ij=v2(j+1,itori,itori1)
5105 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5106 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5110 v1ij=v1(j,itori,itori1)
5111 v2ij=v2(j,itori,itori1)
5114 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5115 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5119 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5120 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5121 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5122 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5123 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5125 ! 6/20/98 - dihedral angle constraints
5128 itori=idih_constr(i)
5131 if (difi.gt.drange(i)) then
5133 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5134 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5135 else if (difi.lt.-drange(i)) then
5137 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5138 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5140 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5141 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5143 ! write (iout,*) 'edihcnstr',edihcnstr
5146 c------------------------------------------------------------------------------
5148 subroutine etor(etors,edihcnstr,fact)
5149 implicit real*8 (a-h,o-z)
5150 include 'DIMENSIONS'
5151 include 'sizesclu.dat'
5152 include 'COMMON.VAR'
5153 include 'COMMON.GEO'
5154 include 'COMMON.LOCAL'
5155 include 'COMMON.TORSION'
5156 include 'COMMON.INTERACT'
5157 include 'COMMON.DERIV'
5158 include 'COMMON.CHAIN'
5159 include 'COMMON.NAMES'
5160 include 'COMMON.IOUNITS'
5161 include 'COMMON.FFIELD'
5162 include 'COMMON.TORCNSTR'
5164 C Set lprn=.true. for debugging
5168 do i=iphi_start,iphi_end
5170 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5171 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5172 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5173 if (iabs(itype(i)).eq.20) then
5178 itori=itortyp(itype(i-2))
5179 itori1=itortyp(itype(i-1))
5182 C Regular cosine and sine terms
5183 do j=1,nterm(itori,itori1,iblock)
5184 v1ij=v1(j,itori,itori1,iblock)
5185 v2ij=v2(j,itori,itori1,iblock)
5188 etors=etors+v1ij*cosphi+v2ij*sinphi
5189 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5193 C E = SUM ----------------------------------- - v1
5194 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5196 cosphi=dcos(0.5d0*phii)
5197 sinphi=dsin(0.5d0*phii)
5198 do j=1,nlor(itori,itori1,iblock)
5199 vl1ij=vlor1(j,itori,itori1)
5200 vl2ij=vlor2(j,itori,itori1)
5201 vl3ij=vlor3(j,itori,itori1)
5202 pom=vl2ij*cosphi+vl3ij*sinphi
5203 pom1=1.0d0/(pom*pom+1.0d0)
5204 etors=etors+vl1ij*pom1
5206 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5208 C Subtract the constant term
5209 etors=etors-v0(itori,itori1,iblock)
5211 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5212 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5213 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5214 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5215 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5218 ! 6/20/98 - dihedral angle constraints
5221 itori=idih_constr(i)
5223 difi=pinorm(phii-phi0(i))
5225 if (difi.gt.drange(i)) then
5227 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5228 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5229 edihi=0.25d0*ftors(i)*difi**4
5230 else if (difi.lt.-drange(i)) then
5232 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5233 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5234 edihi=0.25d0*ftors(i)*difi**4
5238 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5240 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5241 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5243 ! write (iout,*) 'edihcnstr',edihcnstr
5246 c----------------------------------------------------------------------------
5247 subroutine etor_d(etors_d,fact2)
5248 C 6/23/01 Compute double torsional energy
5249 implicit real*8 (a-h,o-z)
5250 include 'DIMENSIONS'
5251 include 'sizesclu.dat'
5252 include 'COMMON.VAR'
5253 include 'COMMON.GEO'
5254 include 'COMMON.LOCAL'
5255 include 'COMMON.TORSION'
5256 include 'COMMON.INTERACT'
5257 include 'COMMON.DERIV'
5258 include 'COMMON.CHAIN'
5259 include 'COMMON.NAMES'
5260 include 'COMMON.IOUNITS'
5261 include 'COMMON.FFIELD'
5262 include 'COMMON.TORCNSTR'
5264 C Set lprn=.true. for debugging
5268 do i=iphi_start,iphi_end-1
5270 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5271 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5272 & (itype(i+1).eq.ntyp1)) cycle
5273 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5275 itori=itortyp(itype(i-2))
5276 itori1=itortyp(itype(i-1))
5277 itori2=itortyp(itype(i))
5283 if (iabs(itype(i+1)).eq.20) iblock=2
5284 C Regular cosine and sine terms
5285 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5286 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5287 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5288 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5289 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5290 cosphi1=dcos(j*phii)
5291 sinphi1=dsin(j*phii)
5292 cosphi2=dcos(j*phii1)
5293 sinphi2=dsin(j*phii1)
5294 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5295 & v2cij*cosphi2+v2sij*sinphi2
5296 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5297 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5299 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5301 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5302 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5303 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5304 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5305 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5306 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5307 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5308 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5309 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5310 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5311 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5312 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5313 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5314 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5317 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5318 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5324 c------------------------------------------------------------------------------
5325 subroutine eback_sc_corr(esccor)
5326 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5327 c conformational states; temporarily implemented as differences
5328 c between UNRES torsional potentials (dependent on three types of
5329 c residues) and the torsional potentials dependent on all 20 types
5330 c of residues computed from AM1 energy surfaces of terminally-blocked
5331 c amino-acid residues.
5332 implicit real*8 (a-h,o-z)
5333 include 'DIMENSIONS'
5334 include 'sizesclu.dat'
5335 include 'COMMON.VAR'
5336 include 'COMMON.GEO'
5337 include 'COMMON.LOCAL'
5338 include 'COMMON.TORSION'
5339 include 'COMMON.SCCOR'
5340 include 'COMMON.INTERACT'
5341 include 'COMMON.DERIV'
5342 include 'COMMON.CHAIN'
5343 include 'COMMON.NAMES'
5344 include 'COMMON.IOUNITS'
5345 include 'COMMON.FFIELD'
5346 include 'COMMON.CONTROL'
5348 C Set lprn=.true. for debugging
5351 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5353 do i=itau_start,itau_end
5354 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5356 isccori=isccortyp(itype(i-2))
5357 isccori1=isccortyp(itype(i-1))
5359 do intertyp=1,3 !intertyp
5360 cc Added 09 May 2012 (Adasko)
5361 cc Intertyp means interaction type of backbone mainchain correlation:
5362 c 1 = SC...Ca...Ca...Ca
5363 c 2 = Ca...Ca...Ca...SC
5364 c 3 = SC...Ca...Ca...SCi
5366 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5367 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5368 & (itype(i-1).eq.ntyp1)))
5369 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5370 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5371 & .or.(itype(i).eq.ntyp1)))
5372 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5373 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5374 & (itype(i-3).eq.ntyp1)))) cycle
5375 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5376 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5378 do j=1,nterm_sccor(isccori,isccori1)
5379 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5380 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5381 cosphi=dcos(j*tauangle(intertyp,i))
5382 sinphi=dsin(j*tauangle(intertyp,i))
5383 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5384 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5386 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
5387 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
5389 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5390 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5391 & (v1sccor(j,1,itori,itori1),j=1,6),
5392 & (v2sccor(j,1,itori,itori1),j=1,6)
5393 gsccor_loc(i-3)=gloci
5398 c------------------------------------------------------------------------------
5399 subroutine multibody(ecorr)
5400 C This subroutine calculates multi-body contributions to energy following
5401 C the idea of Skolnick et al. If side chains I and J make a contact and
5402 C at the same time side chains I+1 and J+1 make a contact, an extra
5403 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5404 implicit real*8 (a-h,o-z)
5405 include 'DIMENSIONS'
5406 include 'COMMON.IOUNITS'
5407 include 'COMMON.DERIV'
5408 include 'COMMON.INTERACT'
5409 include 'COMMON.CONTACTS'
5410 double precision gx(3),gx1(3)
5413 C Set lprn=.true. for debugging
5417 write (iout,'(a)') 'Contact function values:'
5419 write (iout,'(i2,20(1x,i2,f10.5))')
5420 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5435 num_conti=num_cont(i)
5436 num_conti1=num_cont(i1)
5441 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5442 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5443 cd & ' ishift=',ishift
5444 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5445 C The system gains extra energy.
5446 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5447 endif ! j1==j+-ishift
5456 c------------------------------------------------------------------------------
5457 double precision function esccorr(i,j,k,l,jj,kk)
5458 implicit real*8 (a-h,o-z)
5459 include 'DIMENSIONS'
5460 include 'COMMON.IOUNITS'
5461 include 'COMMON.DERIV'
5462 include 'COMMON.INTERACT'
5463 include 'COMMON.CONTACTS'
5464 double precision gx(3),gx1(3)
5469 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5470 C Calculate the multi-body contribution to energy.
5471 C Calculate multi-body contributions to the gradient.
5472 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5473 cd & k,l,(gacont(m,kk,k),m=1,3)
5475 gx(m) =ekl*gacont(m,jj,i)
5476 gx1(m)=eij*gacont(m,kk,k)
5477 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5478 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5479 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5480 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5484 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5489 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5495 c------------------------------------------------------------------------------
5497 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5498 implicit real*8 (a-h,o-z)
5499 include 'DIMENSIONS'
5500 integer dimen1,dimen2,atom,indx
5501 double precision buffer(dimen1,dimen2)
5502 double precision zapas
5503 common /contacts_hb/ zapas(3,20,maxres,7),
5504 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
5505 & num_cont_hb(maxres),jcont_hb(20,maxres)
5506 num_kont=num_cont_hb(atom)
5510 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5513 buffer(i,indx+22)=facont_hb(i,atom)
5514 buffer(i,indx+23)=ees0p(i,atom)
5515 buffer(i,indx+24)=ees0m(i,atom)
5516 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5518 buffer(1,indx+26)=dfloat(num_kont)
5521 c------------------------------------------------------------------------------
5522 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5523 implicit real*8 (a-h,o-z)
5524 include 'DIMENSIONS'
5525 integer dimen1,dimen2,atom,indx
5526 double precision buffer(dimen1,dimen2)
5527 double precision zapas
5528 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5529 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5530 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5531 num_kont=buffer(1,indx+26)
5532 num_kont_old=num_cont_hb(atom)
5533 num_cont_hb(atom)=num_kont+num_kont_old
5538 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5541 facont_hb(ii,atom)=buffer(i,indx+22)
5542 ees0p(ii,atom)=buffer(i,indx+23)
5543 ees0m(ii,atom)=buffer(i,indx+24)
5544 jcont_hb(ii,atom)=buffer(i,indx+25)
5548 c------------------------------------------------------------------------------
5550 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5551 C This subroutine calculates multi-body contributions to hydrogen-bonding
5552 implicit real*8 (a-h,o-z)
5553 include 'DIMENSIONS'
5554 include 'sizesclu.dat'
5555 include 'COMMON.IOUNITS'
5557 include 'COMMON.INFO'
5559 include 'COMMON.FFIELD'
5560 include 'COMMON.DERIV'
5561 include 'COMMON.INTERACT'
5562 include 'COMMON.CONTACTS'
5564 parameter (max_cont=maxconts)
5565 parameter (max_dim=2*(8*3+2))
5566 parameter (msglen1=max_cont*max_dim*4)
5567 parameter (msglen2=2*msglen1)
5568 integer source,CorrelType,CorrelID,Error
5569 double precision buffer(max_cont,max_dim)
5571 double precision gx(3),gx1(3)
5574 C Set lprn=.true. for debugging
5579 if (fgProcs.le.1) goto 30
5581 write (iout,'(a)') 'Contact function values:'
5583 write (iout,'(2i3,50(1x,i2,f5.2))')
5584 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5585 & j=1,num_cont_hb(i))
5588 C Caution! Following code assumes that electrostatic interactions concerning
5589 C a given atom are split among at most two processors!
5599 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5602 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5603 if (MyRank.gt.0) then
5604 C Send correlation contributions to the preceding processor
5606 nn=num_cont_hb(iatel_s)
5607 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5608 cd write (iout,*) 'The BUFFER array:'
5610 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5612 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5614 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5615 C Clear the contacts of the atom passed to the neighboring processor
5616 nn=num_cont_hb(iatel_s+1)
5618 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5620 num_cont_hb(iatel_s)=0
5622 cd write (iout,*) 'Processor ',MyID,MyRank,
5623 cd & ' is sending correlation contribution to processor',MyID-1,
5624 cd & ' msglen=',msglen
5625 cd write (*,*) 'Processor ',MyID,MyRank,
5626 cd & ' is sending correlation contribution to processor',MyID-1,
5627 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5628 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5629 cd write (iout,*) 'Processor ',MyID,
5630 cd & ' has sent correlation contribution to processor',MyID-1,
5631 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5632 cd write (*,*) 'Processor ',MyID,
5633 cd & ' has sent correlation contribution to processor',MyID-1,
5634 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5636 endif ! (MyRank.gt.0)
5640 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5641 if (MyRank.lt.fgProcs-1) then
5642 C Receive correlation contributions from the next processor
5644 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5645 cd write (iout,*) 'Processor',MyID,
5646 cd & ' is receiving correlation contribution from processor',MyID+1,
5647 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5648 cd write (*,*) 'Processor',MyID,
5649 cd & ' is receiving correlation contribution from processor',MyID+1,
5650 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5652 do while (nbytes.le.0)
5653 call mp_probe(MyID+1,CorrelType,nbytes)
5655 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5656 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5657 cd write (iout,*) 'Processor',MyID,
5658 cd & ' has received correlation contribution from processor',MyID+1,
5659 cd & ' msglen=',msglen,' nbytes=',nbytes
5660 cd write (iout,*) 'The received BUFFER array:'
5662 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5664 if (msglen.eq.msglen1) then
5665 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5666 else if (msglen.eq.msglen2) then
5667 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5668 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5671 & 'ERROR!!!! message length changed while processing correlations.'
5673 & 'ERROR!!!! message length changed while processing correlations.'
5674 call mp_stopall(Error)
5675 endif ! msglen.eq.msglen1
5676 endif ! MyRank.lt.fgProcs-1
5683 write (iout,'(a)') 'Contact function values:'
5685 write (iout,'(2i3,50(1x,i2,f5.2))')
5686 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5687 & j=1,num_cont_hb(i))
5691 C Remove the loop below after debugging !!!
5698 C Calculate the local-electrostatic correlation terms
5699 do i=iatel_s,iatel_e+1
5701 num_conti=num_cont_hb(i)
5702 num_conti1=num_cont_hb(i+1)
5707 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5708 c & ' jj=',jj,' kk=',kk
5709 if (j1.eq.j+1 .or. j1.eq.j-1) then
5710 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5711 C The system gains extra energy.
5712 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5714 else if (j1.eq.j) then
5715 C Contacts I-J and I-(J+1) occur simultaneously.
5716 C The system loses extra energy.
5717 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5722 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5723 c & ' jj=',jj,' kk=',kk
5725 C Contacts I-J and (I+1)-J occur simultaneously.
5726 C The system loses extra energy.
5727 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5734 c------------------------------------------------------------------------------
5735 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5737 C This subroutine calculates multi-body contributions to hydrogen-bonding
5738 implicit real*8 (a-h,o-z)
5739 include 'DIMENSIONS'
5740 include 'sizesclu.dat'
5741 include 'COMMON.IOUNITS'
5743 include 'COMMON.INFO'
5745 include 'COMMON.FFIELD'
5746 include 'COMMON.DERIV'
5747 include 'COMMON.INTERACT'
5748 include 'COMMON.CONTACTS'
5750 parameter (max_cont=maxconts)
5751 parameter (max_dim=2*(8*3+2))
5752 parameter (msglen1=max_cont*max_dim*4)
5753 parameter (msglen2=2*msglen1)
5754 integer source,CorrelType,CorrelID,Error
5755 double precision buffer(max_cont,max_dim)
5757 double precision gx(3),gx1(3)
5760 C Set lprn=.true. for debugging
5766 if (fgProcs.le.1) goto 30
5768 write (iout,'(a)') 'Contact function values:'
5770 write (iout,'(2i3,50(1x,i2,f5.2))')
5771 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5772 & j=1,num_cont_hb(i))
5775 C Caution! Following code assumes that electrostatic interactions concerning
5776 C a given atom are split among at most two processors!
5786 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5789 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5790 if (MyRank.gt.0) then
5791 C Send correlation contributions to the preceding processor
5793 nn=num_cont_hb(iatel_s)
5794 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5795 cd write (iout,*) 'The BUFFER array:'
5797 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5799 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5801 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5802 C Clear the contacts of the atom passed to the neighboring processor
5803 nn=num_cont_hb(iatel_s+1)
5805 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5807 num_cont_hb(iatel_s)=0
5809 cd write (iout,*) 'Processor ',MyID,MyRank,
5810 cd & ' is sending correlation contribution to processor',MyID-1,
5811 cd & ' msglen=',msglen
5812 cd write (*,*) 'Processor ',MyID,MyRank,
5813 cd & ' is sending correlation contribution to processor',MyID-1,
5814 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5815 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5816 cd write (iout,*) 'Processor ',MyID,
5817 cd & ' has sent correlation contribution to processor',MyID-1,
5818 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5819 cd write (*,*) 'Processor ',MyID,
5820 cd & ' has sent correlation contribution to processor',MyID-1,
5821 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5823 endif ! (MyRank.gt.0)
5827 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5828 if (MyRank.lt.fgProcs-1) then
5829 C Receive correlation contributions from the next processor
5831 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5832 cd write (iout,*) 'Processor',MyID,
5833 cd & ' is receiving correlation contribution from processor',MyID+1,
5834 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5835 cd write (*,*) 'Processor',MyID,
5836 cd & ' is receiving correlation contribution from processor',MyID+1,
5837 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5839 do while (nbytes.le.0)
5840 call mp_probe(MyID+1,CorrelType,nbytes)
5842 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5843 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5844 cd write (iout,*) 'Processor',MyID,
5845 cd & ' has received correlation contribution from processor',MyID+1,
5846 cd & ' msglen=',msglen,' nbytes=',nbytes
5847 cd write (iout,*) 'The received BUFFER array:'
5849 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5851 if (msglen.eq.msglen1) then
5852 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5853 else if (msglen.eq.msglen2) then
5854 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5855 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5858 & 'ERROR!!!! message length changed while processing correlations.'
5860 & 'ERROR!!!! message length changed while processing correlations.'
5861 call mp_stopall(Error)
5862 endif ! msglen.eq.msglen1
5863 endif ! MyRank.lt.fgProcs-1
5870 write (iout,'(a)') 'Contact function values:'
5872 write (iout,'(2i3,50(1x,i2,f5.2))')
5873 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5874 & j=1,num_cont_hb(i))
5880 C Remove the loop below after debugging !!!
5887 C Calculate the dipole-dipole interaction energies
5888 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5889 do i=iatel_s,iatel_e+1
5890 num_conti=num_cont_hb(i)
5897 C Calculate the local-electrostatic correlation terms
5898 do i=iatel_s,iatel_e+1
5900 num_conti=num_cont_hb(i)
5901 num_conti1=num_cont_hb(i+1)
5906 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5907 c & ' jj=',jj,' kk=',kk
5908 if (j1.eq.j+1 .or. j1.eq.j-1) then
5909 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5910 C The system gains extra energy.
5912 sqd1=dsqrt(d_cont(jj,i))
5913 sqd2=dsqrt(d_cont(kk,i1))
5914 sred_geom = sqd1*sqd2
5915 IF (sred_geom.lt.cutoff_corr) THEN
5916 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5918 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5919 c & ' jj=',jj,' kk=',kk
5920 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5921 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5923 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5924 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5927 cd write (iout,*) 'sred_geom=',sred_geom,
5928 cd & ' ekont=',ekont,' fprim=',fprimcont
5929 call calc_eello(i,j,i+1,j1,jj,kk)
5930 if (wcorr4.gt.0.0d0)
5931 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5932 if (wcorr5.gt.0.0d0)
5933 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5934 c print *,"wcorr5",ecorr5
5935 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5936 cd write(2,*)'ijkl',i,j,i+1,j1
5937 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5938 & .or. wturn6.eq.0.0d0))then
5939 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5940 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5941 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5942 cd & 'ecorr6=',ecorr6
5943 cd write (iout,'(4e15.5)') sred_geom,
5944 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5945 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5946 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5947 else if (wturn6.gt.0.0d0
5948 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5949 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5950 eturn6=eturn6+eello_turn6(i,jj,kk)
5951 cd write (2,*) 'multibody_eello:eturn6',eturn6
5955 else if (j1.eq.j) then
5956 C Contacts I-J and I-(J+1) occur simultaneously.
5957 C The system loses extra energy.
5958 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5963 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5964 c & ' jj=',jj,' kk=',kk
5966 C Contacts I-J and (I+1)-J occur simultaneously.
5967 C The system loses extra energy.
5968 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5975 c------------------------------------------------------------------------------
5976 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5977 implicit real*8 (a-h,o-z)
5978 include 'DIMENSIONS'
5979 include 'COMMON.IOUNITS'
5980 include 'COMMON.DERIV'
5981 include 'COMMON.INTERACT'
5982 include 'COMMON.CONTACTS'
5983 include 'COMMON.SHIELD'
5985 double precision gx(3),gx1(3)
5995 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5996 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5997 C Following 4 lines for diagnostics.
6002 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6004 c write (iout,*)'Contacts have occurred for peptide groups',
6005 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6006 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6007 C Calculate the multi-body contribution to energy.
6008 ecorr=ecorr+ekont*ees
6010 C Calculate multi-body contributions to the gradient.
6012 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6013 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6014 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6015 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6016 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6017 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6018 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6019 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6020 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6021 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6022 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6023 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6024 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6025 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6029 gradcorr(ll,m)=gradcorr(ll,m)+
6030 & ees*ekl*gacont_hbr(ll,jj,i)-
6031 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6032 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6037 gradcorr(ll,m)=gradcorr(ll,m)+
6038 & ees*eij*gacont_hbr(ll,kk,k)-
6039 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6040 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6043 if (shield_mode.gt.0) then
6046 C print *,i,j,fac_shield(i),fac_shield(j),
6047 C &fac_shield(k),fac_shield(l)
6048 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6049 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6050 do ilist=1,ishield_list(i)
6051 iresshield=shield_list(ilist,i)
6053 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6055 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6057 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6058 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6062 do ilist=1,ishield_list(j)
6063 iresshield=shield_list(ilist,j)
6065 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6067 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6069 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6070 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6074 do ilist=1,ishield_list(k)
6075 iresshield=shield_list(ilist,k)
6077 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6079 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6081 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6082 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6086 do ilist=1,ishield_list(l)
6087 iresshield=shield_list(ilist,l)
6089 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6091 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6093 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6094 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6098 C print *,gshieldx(m,iresshield)
6100 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6101 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6102 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6103 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6104 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6105 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6106 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6107 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6109 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6110 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6111 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6112 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6113 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6114 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6115 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6116 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6125 C---------------------------------------------------------------------------
6126 subroutine dipole(i,j,jj)
6127 implicit real*8 (a-h,o-z)
6128 include 'DIMENSIONS'
6129 include 'sizesclu.dat'
6130 include 'COMMON.IOUNITS'
6131 include 'COMMON.CHAIN'
6132 include 'COMMON.FFIELD'
6133 include 'COMMON.DERIV'
6134 include 'COMMON.INTERACT'
6135 include 'COMMON.CONTACTS'
6136 include 'COMMON.TORSION'
6137 include 'COMMON.VAR'
6138 include 'COMMON.GEO'
6139 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6141 iti1 = itortyp(itype(i+1))
6142 if (j.lt.nres-1) then
6143 if (itype(j).le.ntyp) then
6144 itj1 = itortyp(itype(j+1))
6152 dipi(iii,1)=Ub2(iii,i)
6153 dipderi(iii)=Ub2der(iii,i)
6154 dipi(iii,2)=b1(iii,iti1)
6155 dipj(iii,1)=Ub2(iii,j)
6156 dipderj(iii)=Ub2der(iii,j)
6157 dipj(iii,2)=b1(iii,itj1)
6161 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6164 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6167 if (.not.calc_grad) return
6172 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6176 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6181 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6182 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6184 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6186 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6188 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6192 C---------------------------------------------------------------------------
6193 subroutine calc_eello(i,j,k,l,jj,kk)
6195 C This subroutine computes matrices and vectors needed to calculate
6196 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6198 implicit real*8 (a-h,o-z)
6199 include 'DIMENSIONS'
6200 include 'sizesclu.dat'
6201 include 'COMMON.IOUNITS'
6202 include 'COMMON.CHAIN'
6203 include 'COMMON.DERIV'
6204 include 'COMMON.INTERACT'
6205 include 'COMMON.CONTACTS'
6206 include 'COMMON.TORSION'
6207 include 'COMMON.VAR'
6208 include 'COMMON.GEO'
6209 include 'COMMON.FFIELD'
6210 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6211 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6214 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6215 cd & ' jj=',jj,' kk=',kk
6216 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6219 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6220 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6223 call transpose2(aa1(1,1),aa1t(1,1))
6224 call transpose2(aa2(1,1),aa2t(1,1))
6227 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6228 & aa1tder(1,1,lll,kkk))
6229 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6230 & aa2tder(1,1,lll,kkk))
6234 C parallel orientation of the two CA-CA-CA frames.
6236 if (i.gt.1 .and. itype(i).le.ntyp) then
6237 iti=itortyp(itype(i))
6241 itk1=itortyp(itype(k+1))
6242 itj=itortyp(itype(j))
6243 c if (l.lt.nres-1) then
6244 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6245 itl1=itortyp(itype(l+1))
6249 C A1 kernel(j+1) A2T
6251 cd write (iout,'(3f10.5,5x,3f10.5)')
6252 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6254 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6255 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6256 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6257 C Following matrices are needed only for 6-th order cumulants
6258 IF (wcorr6.gt.0.0d0) THEN
6259 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6260 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6261 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6262 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6263 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6264 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6265 & ADtEAderx(1,1,1,1,1,1))
6267 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6268 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6269 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6270 & ADtEA1derx(1,1,1,1,1,1))
6272 C End 6-th order cumulants
6275 cd write (2,*) 'In calc_eello6'
6277 cd write (2,*) 'iii=',iii
6279 cd write (2,*) 'kkk=',kkk
6281 cd write (2,'(3(2f10.5),5x)')
6282 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6287 call transpose2(EUgder(1,1,k),auxmat(1,1))
6288 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6289 call transpose2(EUg(1,1,k),auxmat(1,1))
6290 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6291 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6295 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6296 & EAEAderx(1,1,lll,kkk,iii,1))
6300 C A1T kernel(i+1) A2
6301 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6302 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6303 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6304 C Following matrices are needed only for 6-th order cumulants
6305 IF (wcorr6.gt.0.0d0) THEN
6306 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6307 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6308 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6309 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6310 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6311 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6312 & ADtEAderx(1,1,1,1,1,2))
6313 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6314 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6315 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6316 & ADtEA1derx(1,1,1,1,1,2))
6318 C End 6-th order cumulants
6319 call transpose2(EUgder(1,1,l),auxmat(1,1))
6320 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6321 call transpose2(EUg(1,1,l),auxmat(1,1))
6322 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6323 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6327 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6328 & EAEAderx(1,1,lll,kkk,iii,2))
6333 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6334 C They are needed only when the fifth- or the sixth-order cumulants are
6336 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6337 call transpose2(AEA(1,1,1),auxmat(1,1))
6338 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6339 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6340 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6341 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6342 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6343 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6344 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6345 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6346 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6347 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6348 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6349 call transpose2(AEA(1,1,2),auxmat(1,1))
6350 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6351 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6352 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6353 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6354 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6355 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6356 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6357 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6358 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6359 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6360 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6361 C Calculate the Cartesian derivatives of the vectors.
6365 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6366 call matvec2(auxmat(1,1),b1(1,iti),
6367 & AEAb1derx(1,lll,kkk,iii,1,1))
6368 call matvec2(auxmat(1,1),Ub2(1,i),
6369 & AEAb2derx(1,lll,kkk,iii,1,1))
6370 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6371 & AEAb1derx(1,lll,kkk,iii,2,1))
6372 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6373 & AEAb2derx(1,lll,kkk,iii,2,1))
6374 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6375 call matvec2(auxmat(1,1),b1(1,itj),
6376 & AEAb1derx(1,lll,kkk,iii,1,2))
6377 call matvec2(auxmat(1,1),Ub2(1,j),
6378 & AEAb2derx(1,lll,kkk,iii,1,2))
6379 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6380 & AEAb1derx(1,lll,kkk,iii,2,2))
6381 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6382 & AEAb2derx(1,lll,kkk,iii,2,2))
6389 C Antiparallel orientation of the two CA-CA-CA frames.
6391 if (i.gt.1 .and. itype(i).le.ntyp) then
6392 iti=itortyp(itype(i))
6396 itk1=itortyp(itype(k+1))
6397 itl=itortyp(itype(l))
6398 itj=itortyp(itype(j))
6399 c if (j.lt.nres-1) then
6400 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6401 itj1=itortyp(itype(j+1))
6405 C A2 kernel(j-1)T A1T
6406 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6407 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6408 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6409 C Following matrices are needed only for 6-th order cumulants
6410 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6411 & j.eq.i+4 .and. l.eq.i+3)) THEN
6412 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6413 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6414 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6415 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6416 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6417 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6418 & ADtEAderx(1,1,1,1,1,1))
6419 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6420 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6421 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6422 & ADtEA1derx(1,1,1,1,1,1))
6424 C End 6-th order cumulants
6425 call transpose2(EUgder(1,1,k),auxmat(1,1))
6426 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6427 call transpose2(EUg(1,1,k),auxmat(1,1))
6428 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6429 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6433 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6434 & EAEAderx(1,1,lll,kkk,iii,1))
6438 C A2T kernel(i+1)T A1
6439 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6440 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6441 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6442 C Following matrices are needed only for 6-th order cumulants
6443 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6444 & j.eq.i+4 .and. l.eq.i+3)) THEN
6445 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6446 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6447 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6448 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6449 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6450 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6451 & ADtEAderx(1,1,1,1,1,2))
6452 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6453 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6454 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6455 & ADtEA1derx(1,1,1,1,1,2))
6457 C End 6-th order cumulants
6458 call transpose2(EUgder(1,1,j),auxmat(1,1))
6459 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6460 call transpose2(EUg(1,1,j),auxmat(1,1))
6461 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6462 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6466 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6467 & EAEAderx(1,1,lll,kkk,iii,2))
6472 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6473 C They are needed only when the fifth- or the sixth-order cumulants are
6475 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6476 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6477 call transpose2(AEA(1,1,1),auxmat(1,1))
6478 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6479 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6480 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6481 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6482 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6483 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6484 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6485 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6486 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6487 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6488 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6489 call transpose2(AEA(1,1,2),auxmat(1,1))
6490 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6491 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6492 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6493 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6494 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6495 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6496 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6497 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6498 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6499 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6500 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6501 C Calculate the Cartesian derivatives of the vectors.
6505 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6506 call matvec2(auxmat(1,1),b1(1,iti),
6507 & AEAb1derx(1,lll,kkk,iii,1,1))
6508 call matvec2(auxmat(1,1),Ub2(1,i),
6509 & AEAb2derx(1,lll,kkk,iii,1,1))
6510 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6511 & AEAb1derx(1,lll,kkk,iii,2,1))
6512 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6513 & AEAb2derx(1,lll,kkk,iii,2,1))
6514 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6515 call matvec2(auxmat(1,1),b1(1,itl),
6516 & AEAb1derx(1,lll,kkk,iii,1,2))
6517 call matvec2(auxmat(1,1),Ub2(1,l),
6518 & AEAb2derx(1,lll,kkk,iii,1,2))
6519 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6520 & AEAb1derx(1,lll,kkk,iii,2,2))
6521 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6522 & AEAb2derx(1,lll,kkk,iii,2,2))
6531 C---------------------------------------------------------------------------
6532 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6533 & KK,KKderg,AKA,AKAderg,AKAderx)
6537 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6538 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6539 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6544 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6546 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6549 cd if (lprn) write (2,*) 'In kernel'
6551 cd if (lprn) write (2,*) 'kkk=',kkk
6553 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6554 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6556 cd write (2,*) 'lll=',lll
6557 cd write (2,*) 'iii=1'
6559 cd write (2,'(3(2f10.5),5x)')
6560 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6563 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6564 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6566 cd write (2,*) 'lll=',lll
6567 cd write (2,*) 'iii=2'
6569 cd write (2,'(3(2f10.5),5x)')
6570 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6577 C---------------------------------------------------------------------------
6578 double precision function eello4(i,j,k,l,jj,kk)
6579 implicit real*8 (a-h,o-z)
6580 include 'DIMENSIONS'
6581 include 'sizesclu.dat'
6582 include 'COMMON.IOUNITS'
6583 include 'COMMON.CHAIN'
6584 include 'COMMON.DERIV'
6585 include 'COMMON.INTERACT'
6586 include 'COMMON.CONTACTS'
6587 include 'COMMON.TORSION'
6588 include 'COMMON.VAR'
6589 include 'COMMON.GEO'
6590 double precision pizda(2,2),ggg1(3),ggg2(3)
6591 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6595 cd print *,'eello4:',i,j,k,l,jj,kk
6596 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6597 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6598 cold eij=facont_hb(jj,i)
6599 cold ekl=facont_hb(kk,k)
6601 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6603 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6604 gcorr_loc(k-1)=gcorr_loc(k-1)
6605 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6607 gcorr_loc(l-1)=gcorr_loc(l-1)
6608 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6610 gcorr_loc(j-1)=gcorr_loc(j-1)
6611 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6616 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6617 & -EAEAderx(2,2,lll,kkk,iii,1)
6618 cd derx(lll,kkk,iii)=0.0d0
6622 cd gcorr_loc(l-1)=0.0d0
6623 cd gcorr_loc(j-1)=0.0d0
6624 cd gcorr_loc(k-1)=0.0d0
6626 cd write (iout,*)'Contacts have occurred for peptide groups',
6627 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6628 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6629 if (j.lt.nres-1) then
6636 if (l.lt.nres-1) then
6644 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6645 ggg1(ll)=eel4*g_contij(ll,1)
6646 ggg2(ll)=eel4*g_contij(ll,2)
6647 ghalf=0.5d0*ggg1(ll)
6649 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6650 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6651 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6652 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6653 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6654 ghalf=0.5d0*ggg2(ll)
6656 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6657 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6658 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6659 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6664 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6665 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6670 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6671 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6677 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6682 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6686 cd write (2,*) iii,gcorr_loc(iii)
6690 cd write (2,*) 'ekont',ekont
6691 cd write (iout,*) 'eello4',ekont*eel4
6694 C---------------------------------------------------------------------------
6695 double precision function eello5(i,j,k,l,jj,kk)
6696 implicit real*8 (a-h,o-z)
6697 include 'DIMENSIONS'
6698 include 'sizesclu.dat'
6699 include 'COMMON.IOUNITS'
6700 include 'COMMON.CHAIN'
6701 include 'COMMON.DERIV'
6702 include 'COMMON.INTERACT'
6703 include 'COMMON.CONTACTS'
6704 include 'COMMON.TORSION'
6705 include 'COMMON.VAR'
6706 include 'COMMON.GEO'
6707 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6708 double precision ggg1(3),ggg2(3)
6709 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6714 C /l\ / \ \ / \ / \ / C
6715 C / \ / \ \ / \ / \ / C
6716 C j| o |l1 | o | o| o | | o |o C
6717 C \ |/k\| |/ \| / |/ \| |/ \| C
6718 C \i/ \ / \ / / \ / \ C
6720 C (I) (II) (III) (IV) C
6722 C eello5_1 eello5_2 eello5_3 eello5_4 C
6724 C Antiparallel chains C
6727 C /j\ / \ \ / \ / \ / C
6728 C / \ / \ \ / \ / \ / C
6729 C j1| o |l | o | o| o | | o |o C
6730 C \ |/k\| |/ \| / |/ \| |/ \| C
6731 C \i/ \ / \ / / \ / \ C
6733 C (I) (II) (III) (IV) C
6735 C eello5_1 eello5_2 eello5_3 eello5_4 C
6737 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6739 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6740 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6745 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6747 itk=itortyp(itype(k))
6748 itl=itortyp(itype(l))
6749 itj=itortyp(itype(j))
6754 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6755 cd & eel5_3_num,eel5_4_num)
6759 derx(lll,kkk,iii)=0.0d0
6763 cd eij=facont_hb(jj,i)
6764 cd ekl=facont_hb(kk,k)
6766 cd write (iout,*)'Contacts have occurred for peptide groups',
6767 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6769 C Contribution from the graph I.
6770 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6771 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6772 call transpose2(EUg(1,1,k),auxmat(1,1))
6773 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6774 vv(1)=pizda(1,1)-pizda(2,2)
6775 vv(2)=pizda(1,2)+pizda(2,1)
6776 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6777 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6779 C Explicit gradient in virtual-dihedral angles.
6780 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6781 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6782 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6783 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6784 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6785 vv(1)=pizda(1,1)-pizda(2,2)
6786 vv(2)=pizda(1,2)+pizda(2,1)
6787 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6788 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6789 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6790 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6791 vv(1)=pizda(1,1)-pizda(2,2)
6792 vv(2)=pizda(1,2)+pizda(2,1)
6794 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6795 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6796 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6798 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6799 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6800 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6802 C Cartesian gradient
6806 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6808 vv(1)=pizda(1,1)-pizda(2,2)
6809 vv(2)=pizda(1,2)+pizda(2,1)
6810 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6811 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6812 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6819 C Contribution from graph II
6820 call transpose2(EE(1,1,itk),auxmat(1,1))
6821 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6822 vv(1)=pizda(1,1)+pizda(2,2)
6823 vv(2)=pizda(2,1)-pizda(1,2)
6824 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6825 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6827 C Explicit gradient in virtual-dihedral angles.
6828 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6829 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6830 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6831 vv(1)=pizda(1,1)+pizda(2,2)
6832 vv(2)=pizda(2,1)-pizda(1,2)
6834 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6835 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6836 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6838 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6839 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6840 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6842 C Cartesian gradient
6846 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6848 vv(1)=pizda(1,1)+pizda(2,2)
6849 vv(2)=pizda(2,1)-pizda(1,2)
6850 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6851 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6852 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6861 C Parallel orientation
6862 C Contribution from graph III
6863 call transpose2(EUg(1,1,l),auxmat(1,1))
6864 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6865 vv(1)=pizda(1,1)-pizda(2,2)
6866 vv(2)=pizda(1,2)+pizda(2,1)
6867 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6868 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6870 C Explicit gradient in virtual-dihedral angles.
6871 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6872 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6873 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6874 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6875 vv(1)=pizda(1,1)-pizda(2,2)
6876 vv(2)=pizda(1,2)+pizda(2,1)
6877 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6878 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6879 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6880 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6881 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6882 vv(1)=pizda(1,1)-pizda(2,2)
6883 vv(2)=pizda(1,2)+pizda(2,1)
6884 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6885 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6886 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6887 C Cartesian gradient
6891 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6893 vv(1)=pizda(1,1)-pizda(2,2)
6894 vv(2)=pizda(1,2)+pizda(2,1)
6895 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6896 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6897 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6903 C Contribution from graph IV
6905 call transpose2(EE(1,1,itl),auxmat(1,1))
6906 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6907 vv(1)=pizda(1,1)+pizda(2,2)
6908 vv(2)=pizda(2,1)-pizda(1,2)
6909 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6910 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6912 C Explicit gradient in virtual-dihedral angles.
6913 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6914 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6915 call matmat2(auxmat(1,1),AEAderg(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 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6919 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6920 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6921 C Cartesian gradient
6925 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6927 vv(1)=pizda(1,1)+pizda(2,2)
6928 vv(2)=pizda(2,1)-pizda(1,2)
6929 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6930 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6931 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6937 C Antiparallel orientation
6938 C Contribution from graph III
6940 call transpose2(EUg(1,1,j),auxmat(1,1))
6941 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6942 vv(1)=pizda(1,1)-pizda(2,2)
6943 vv(2)=pizda(1,2)+pizda(2,1)
6944 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6945 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6947 C Explicit gradient in virtual-dihedral angles.
6948 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6949 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6950 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6951 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6952 vv(1)=pizda(1,1)-pizda(2,2)
6953 vv(2)=pizda(1,2)+pizda(2,1)
6954 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6955 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6956 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6957 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6958 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6959 vv(1)=pizda(1,1)-pizda(2,2)
6960 vv(2)=pizda(1,2)+pizda(2,1)
6961 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6962 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6963 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6964 C Cartesian gradient
6968 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6970 vv(1)=pizda(1,1)-pizda(2,2)
6971 vv(2)=pizda(1,2)+pizda(2,1)
6972 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6973 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6974 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6980 C Contribution from graph IV
6982 call transpose2(EE(1,1,itj),auxmat(1,1))
6983 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6984 vv(1)=pizda(1,1)+pizda(2,2)
6985 vv(2)=pizda(2,1)-pizda(1,2)
6986 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6987 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6989 C Explicit gradient in virtual-dihedral angles.
6990 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6991 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6992 call matmat2(auxmat(1,1),AEAderg(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 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6996 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6997 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6998 C Cartesian gradient
7002 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7004 vv(1)=pizda(1,1)+pizda(2,2)
7005 vv(2)=pizda(2,1)-pizda(1,2)
7006 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7007 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7008 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7015 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7016 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7017 cd write (2,*) 'ijkl',i,j,k,l
7018 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7019 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7021 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7022 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7023 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7024 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7026 if (j.lt.nres-1) then
7033 if (l.lt.nres-1) then
7043 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7045 ggg1(ll)=eel5*g_contij(ll,1)
7046 ggg2(ll)=eel5*g_contij(ll,2)
7047 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7048 ghalf=0.5d0*ggg1(ll)
7050 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7051 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7052 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7053 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7054 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7055 ghalf=0.5d0*ggg2(ll)
7057 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7058 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7059 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7060 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7065 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7066 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7071 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7072 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7078 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7083 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7087 cd write (2,*) iii,g_corr5_loc(iii)
7091 cd write (2,*) 'ekont',ekont
7092 cd write (iout,*) 'eello5',ekont*eel5
7095 c--------------------------------------------------------------------------
7096 double precision function eello6(i,j,k,l,jj,kk)
7097 implicit real*8 (a-h,o-z)
7098 include 'DIMENSIONS'
7099 include 'sizesclu.dat'
7100 include 'COMMON.IOUNITS'
7101 include 'COMMON.CHAIN'
7102 include 'COMMON.DERIV'
7103 include 'COMMON.INTERACT'
7104 include 'COMMON.CONTACTS'
7105 include 'COMMON.TORSION'
7106 include 'COMMON.VAR'
7107 include 'COMMON.GEO'
7108 include 'COMMON.FFIELD'
7109 double precision ggg1(3),ggg2(3)
7110 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7115 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7123 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7124 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7128 derx(lll,kkk,iii)=0.0d0
7132 cd eij=facont_hb(jj,i)
7133 cd ekl=facont_hb(kk,k)
7139 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7140 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7141 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7142 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7143 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7144 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7146 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7147 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7148 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7149 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7150 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7151 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7155 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7157 C If turn contributions are considered, they will be handled separately.
7158 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7159 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7160 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7161 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7162 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7163 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7164 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7167 if (j.lt.nres-1) then
7174 if (l.lt.nres-1) then
7182 ggg1(ll)=eel6*g_contij(ll,1)
7183 ggg2(ll)=eel6*g_contij(ll,2)
7184 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7185 ghalf=0.5d0*ggg1(ll)
7187 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7188 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7189 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7190 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7191 ghalf=0.5d0*ggg2(ll)
7192 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7194 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7195 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7196 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7197 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7202 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7203 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7208 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7209 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7215 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7220 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7224 cd write (2,*) iii,g_corr6_loc(iii)
7228 cd write (2,*) 'ekont',ekont
7229 cd write (iout,*) 'eello6',ekont*eel6
7232 c--------------------------------------------------------------------------
7233 double precision function eello6_graph1(i,j,k,l,imat,swap)
7234 implicit real*8 (a-h,o-z)
7235 include 'DIMENSIONS'
7236 include 'sizesclu.dat'
7237 include 'COMMON.IOUNITS'
7238 include 'COMMON.CHAIN'
7239 include 'COMMON.DERIV'
7240 include 'COMMON.INTERACT'
7241 include 'COMMON.CONTACTS'
7242 include 'COMMON.TORSION'
7243 include 'COMMON.VAR'
7244 include 'COMMON.GEO'
7245 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7249 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7251 C Parallel Antiparallel C
7257 C \ j|/k\| / \ |/k\|l / C
7262 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7263 itk=itortyp(itype(k))
7264 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7265 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7266 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7267 call transpose2(EUgC(1,1,k),auxmat(1,1))
7268 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7269 vv1(1)=pizda1(1,1)-pizda1(2,2)
7270 vv1(2)=pizda1(1,2)+pizda1(2,1)
7271 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7272 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7273 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7274 s5=scalar2(vv(1),Dtobr2(1,i))
7275 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7276 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7277 if (.not. calc_grad) return
7278 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7279 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7280 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7281 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7282 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7283 & +scalar2(vv(1),Dtobr2der(1,i)))
7284 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7285 vv1(1)=pizda1(1,1)-pizda1(2,2)
7286 vv1(2)=pizda1(1,2)+pizda1(2,1)
7287 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7288 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7290 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7291 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7292 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7293 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7294 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7296 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7297 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7298 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7299 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7300 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7302 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7303 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7304 vv1(1)=pizda1(1,1)-pizda1(2,2)
7305 vv1(2)=pizda1(1,2)+pizda1(2,1)
7306 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7307 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7308 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7309 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7318 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7319 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7320 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7321 call transpose2(EUgC(1,1,k),auxmat(1,1))
7322 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7324 vv1(1)=pizda1(1,1)-pizda1(2,2)
7325 vv1(2)=pizda1(1,2)+pizda1(2,1)
7326 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7327 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7328 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7329 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7330 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7331 s5=scalar2(vv(1),Dtobr2(1,i))
7332 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7338 c----------------------------------------------------------------------------
7339 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7340 implicit real*8 (a-h,o-z)
7341 include 'DIMENSIONS'
7342 include 'sizesclu.dat'
7343 include 'COMMON.IOUNITS'
7344 include 'COMMON.CHAIN'
7345 include 'COMMON.DERIV'
7346 include 'COMMON.INTERACT'
7347 include 'COMMON.CONTACTS'
7348 include 'COMMON.TORSION'
7349 include 'COMMON.VAR'
7350 include 'COMMON.GEO'
7352 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7353 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7356 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7358 C Parallel Antiparallel C
7364 C \ j|/k\| \ |/k\|l C
7369 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7370 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7371 C AL 7/4/01 s1 would occur in the sixth-order moment,
7372 C but not in a cluster cumulant
7374 s1=dip(1,jj,i)*dip(1,kk,k)
7376 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7377 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7378 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7379 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7380 call transpose2(EUg(1,1,k),auxmat(1,1))
7381 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7382 vv(1)=pizda(1,1)-pizda(2,2)
7383 vv(2)=pizda(1,2)+pizda(2,1)
7384 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7385 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7387 eello6_graph2=-(s1+s2+s3+s4)
7389 eello6_graph2=-(s2+s3+s4)
7392 if (.not. calc_grad) return
7393 C Derivatives in gamma(i-1)
7396 s1=dipderg(1,jj,i)*dip(1,kk,k)
7398 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7399 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7400 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7401 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7403 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7405 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7407 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7409 C Derivatives in gamma(k-1)
7411 s1=dip(1,jj,i)*dipderg(1,kk,k)
7413 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7414 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7415 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7416 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7417 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7418 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7419 vv(1)=pizda(1,1)-pizda(2,2)
7420 vv(2)=pizda(1,2)+pizda(2,1)
7421 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7423 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7425 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7427 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7428 C Derivatives in gamma(j-1) or gamma(l-1)
7431 s1=dipderg(3,jj,i)*dip(1,kk,k)
7433 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7434 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7435 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7436 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7437 vv(1)=pizda(1,1)-pizda(2,2)
7438 vv(2)=pizda(1,2)+pizda(2,1)
7439 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7442 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7444 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7447 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7448 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7450 C Derivatives in gamma(l-1) or gamma(j-1)
7453 s1=dip(1,jj,i)*dipderg(3,kk,k)
7455 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7456 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7457 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7458 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7459 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7460 vv(1)=pizda(1,1)-pizda(2,2)
7461 vv(2)=pizda(1,2)+pizda(2,1)
7462 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7465 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7467 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7470 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7471 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7473 C Cartesian derivatives.
7475 write (2,*) 'In eello6_graph2'
7477 write (2,*) 'iii=',iii
7479 write (2,*) 'kkk=',kkk
7481 write (2,'(3(2f10.5),5x)')
7482 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7492 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7494 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7497 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7499 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7500 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7502 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7503 call transpose2(EUg(1,1,k),auxmat(1,1))
7504 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7506 vv(1)=pizda(1,1)-pizda(2,2)
7507 vv(2)=pizda(1,2)+pizda(2,1)
7508 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7509 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7511 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7513 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7516 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7518 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7525 c----------------------------------------------------------------------------
7526 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7527 implicit real*8 (a-h,o-z)
7528 include 'DIMENSIONS'
7529 include 'sizesclu.dat'
7530 include 'COMMON.IOUNITS'
7531 include 'COMMON.CHAIN'
7532 include 'COMMON.DERIV'
7533 include 'COMMON.INTERACT'
7534 include 'COMMON.CONTACTS'
7535 include 'COMMON.TORSION'
7536 include 'COMMON.VAR'
7537 include 'COMMON.GEO'
7538 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7540 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7542 C Parallel Antiparallel C
7548 C j|/k\| / |/k\|l / C
7553 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7555 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7556 C energy moment and not to the cluster cumulant.
7557 iti=itortyp(itype(i))
7558 c if (j.lt.nres-1) then
7559 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7560 itj1=itortyp(itype(j+1))
7564 itk=itortyp(itype(k))
7565 itk1=itortyp(itype(k+1))
7566 c if (l.lt.nres-1) then
7567 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7568 itl1=itortyp(itype(l+1))
7573 s1=dip(4,jj,i)*dip(4,kk,k)
7575 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7576 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7577 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7578 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7579 call transpose2(EE(1,1,itk),auxmat(1,1))
7580 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7581 vv(1)=pizda(1,1)+pizda(2,2)
7582 vv(2)=pizda(2,1)-pizda(1,2)
7583 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7584 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7586 eello6_graph3=-(s1+s2+s3+s4)
7588 eello6_graph3=-(s2+s3+s4)
7591 if (.not. calc_grad) return
7592 C Derivatives in gamma(k-1)
7593 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7594 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7595 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7596 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7597 C Derivatives in gamma(l-1)
7598 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7599 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7600 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7601 vv(1)=pizda(1,1)+pizda(2,2)
7602 vv(2)=pizda(2,1)-pizda(1,2)
7603 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7604 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7605 C Cartesian derivatives.
7611 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7613 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7616 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7618 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7619 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7621 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7622 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7624 vv(1)=pizda(1,1)+pizda(2,2)
7625 vv(2)=pizda(2,1)-pizda(1,2)
7626 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7628 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7630 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7633 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7635 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7637 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7643 c----------------------------------------------------------------------------
7644 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7645 implicit real*8 (a-h,o-z)
7646 include 'DIMENSIONS'
7647 include 'sizesclu.dat'
7648 include 'COMMON.IOUNITS'
7649 include 'COMMON.CHAIN'
7650 include 'COMMON.DERIV'
7651 include 'COMMON.INTERACT'
7652 include 'COMMON.CONTACTS'
7653 include 'COMMON.TORSION'
7654 include 'COMMON.VAR'
7655 include 'COMMON.GEO'
7656 include 'COMMON.FFIELD'
7657 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7658 & auxvec1(2),auxmat1(2,2)
7660 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7662 C Parallel Antiparallel C
7668 C \ j|/k\| \ |/k\|l C
7673 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7675 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7676 C energy moment and not to the cluster cumulant.
7677 cd write (2,*) 'eello_graph4: wturn6',wturn6
7678 iti=itortyp(itype(i))
7679 itj=itortyp(itype(j))
7680 c if (j.lt.nres-1) then
7681 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7682 itj1=itortyp(itype(j+1))
7686 itk=itortyp(itype(k))
7687 c if (k.lt.nres-1) then
7688 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7689 itk1=itortyp(itype(k+1))
7693 itl=itortyp(itype(l))
7694 if (l.lt.nres-1) then
7695 itl1=itortyp(itype(l+1))
7699 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7700 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7701 cd & ' itl',itl,' itl1',itl1
7704 s1=dip(3,jj,i)*dip(3,kk,k)
7706 s1=dip(2,jj,j)*dip(2,kk,l)
7709 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7710 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7712 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7713 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7715 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7716 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7718 call transpose2(EUg(1,1,k),auxmat(1,1))
7719 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7720 vv(1)=pizda(1,1)-pizda(2,2)
7721 vv(2)=pizda(2,1)+pizda(1,2)
7722 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7723 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7725 eello6_graph4=-(s1+s2+s3+s4)
7727 eello6_graph4=-(s2+s3+s4)
7729 if (.not. calc_grad) return
7730 C Derivatives in gamma(i-1)
7734 s1=dipderg(2,jj,i)*dip(3,kk,k)
7736 s1=dipderg(4,jj,j)*dip(2,kk,l)
7739 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7741 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7742 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7744 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7745 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7747 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7748 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7749 cd write (2,*) 'turn6 derivatives'
7751 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7753 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7757 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7759 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7763 C Derivatives in gamma(k-1)
7766 s1=dip(3,jj,i)*dipderg(2,kk,k)
7768 s1=dip(2,jj,j)*dipderg(4,kk,l)
7771 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7772 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7774 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7775 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7777 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7778 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7780 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7781 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7782 vv(1)=pizda(1,1)-pizda(2,2)
7783 vv(2)=pizda(2,1)+pizda(1,2)
7784 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7785 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7787 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7789 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7793 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7795 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7798 C Derivatives in gamma(j-1) or gamma(l-1)
7799 if (l.eq.j+1 .and. l.gt.1) then
7800 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7801 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7802 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7803 vv(1)=pizda(1,1)-pizda(2,2)
7804 vv(2)=pizda(2,1)+pizda(1,2)
7805 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7806 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7807 else if (j.gt.1) then
7808 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7809 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7810 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7811 vv(1)=pizda(1,1)-pizda(2,2)
7812 vv(2)=pizda(2,1)+pizda(1,2)
7813 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7814 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7815 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7817 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7820 C Cartesian derivatives.
7827 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7829 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7833 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7835 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7839 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7841 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7843 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7844 & b1(1,itj1),auxvec(1))
7845 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7847 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7848 & b1(1,itl1),auxvec(1))
7849 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7851 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7853 vv(1)=pizda(1,1)-pizda(2,2)
7854 vv(2)=pizda(2,1)+pizda(1,2)
7855 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7857 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7859 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7862 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7865 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7868 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7870 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7872 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7876 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7878 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7881 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7883 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7891 c----------------------------------------------------------------------------
7892 double precision function eello_turn6(i,jj,kk)
7893 implicit real*8 (a-h,o-z)
7894 include 'DIMENSIONS'
7895 include 'sizesclu.dat'
7896 include 'COMMON.IOUNITS'
7897 include 'COMMON.CHAIN'
7898 include 'COMMON.DERIV'
7899 include 'COMMON.INTERACT'
7900 include 'COMMON.CONTACTS'
7901 include 'COMMON.TORSION'
7902 include 'COMMON.VAR'
7903 include 'COMMON.GEO'
7904 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7905 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7907 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7908 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7909 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7910 C the respective energy moment and not to the cluster cumulant.
7915 iti=itortyp(itype(i))
7916 itk=itortyp(itype(k))
7917 itk1=itortyp(itype(k+1))
7918 itl=itortyp(itype(l))
7919 itj=itortyp(itype(j))
7920 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7921 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7922 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7927 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7929 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7933 derx_turn(lll,kkk,iii)=0.0d0
7940 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7942 cd write (2,*) 'eello6_5',eello6_5
7944 call transpose2(AEA(1,1,1),auxmat(1,1))
7945 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7946 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7947 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7951 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7952 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7953 s2 = scalar2(b1(1,itk),vtemp1(1))
7955 call transpose2(AEA(1,1,2),atemp(1,1))
7956 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7957 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7958 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7962 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7963 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7964 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7966 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7967 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7968 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7969 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7970 ss13 = scalar2(b1(1,itk),vtemp4(1))
7971 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7975 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7981 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7983 C Derivatives in gamma(i+2)
7985 call transpose2(AEA(1,1,1),auxmatd(1,1))
7986 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7987 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7988 call transpose2(AEAderg(1,1,2),atempd(1,1))
7989 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7990 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7994 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7995 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7996 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8002 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8003 C Derivatives in gamma(i+3)
8005 call transpose2(AEA(1,1,1),auxmatd(1,1))
8006 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8007 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8008 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8012 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8013 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8014 s2d = scalar2(b1(1,itk),vtemp1d(1))
8016 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8017 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8019 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8021 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8022 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8023 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8033 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8034 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8036 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8037 & -0.5d0*ekont*(s2d+s12d)
8039 C Derivatives in gamma(i+4)
8040 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8041 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8042 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8044 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8045 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8046 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8056 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8058 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8060 C Derivatives in gamma(i+5)
8062 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8063 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8064 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8068 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8069 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8070 s2d = scalar2(b1(1,itk),vtemp1d(1))
8072 call transpose2(AEA(1,1,2),atempd(1,1))
8073 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8074 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8078 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8079 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8081 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8082 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8083 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8093 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8094 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8096 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8097 & -0.5d0*ekont*(s2d+s12d)
8099 C Cartesian derivatives
8104 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8105 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8106 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8110 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8111 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8113 s2d = scalar2(b1(1,itk),vtemp1d(1))
8115 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8116 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8117 s8d = -(atempd(1,1)+atempd(2,2))*
8118 & scalar2(cc(1,1,itl),vtemp2(1))
8122 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8124 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8125 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8132 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8135 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8139 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8140 & - 0.5d0*(s8d+s12d)
8142 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8151 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8153 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8154 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8155 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8156 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8157 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8159 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8160 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8161 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8165 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8166 cd & 16*eel_turn6_num
8168 if (j.lt.nres-1) then
8175 if (l.lt.nres-1) then
8183 ggg1(ll)=eel_turn6*g_contij(ll,1)
8184 ggg2(ll)=eel_turn6*g_contij(ll,2)
8185 ghalf=0.5d0*ggg1(ll)
8187 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8188 & +ekont*derx_turn(ll,2,1)
8189 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8190 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8191 & +ekont*derx_turn(ll,4,1)
8192 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8193 ghalf=0.5d0*ggg2(ll)
8195 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8196 & +ekont*derx_turn(ll,2,2)
8197 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8198 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8199 & +ekont*derx_turn(ll,4,2)
8200 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8205 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8210 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8216 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8221 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8225 cd write (2,*) iii,g_corr6_loc(iii)
8228 eello_turn6=ekont*eel_turn6
8229 cd write (2,*) 'ekont',ekont
8230 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8233 crc-------------------------------------------------
8234 SUBROUTINE MATVEC2(A1,V1,V2)
8235 implicit real*8 (a-h,o-z)
8236 include 'DIMENSIONS'
8237 DIMENSION A1(2,2),V1(2),V2(2)
8241 c 3 VI=VI+A1(I,K)*V1(K)
8245 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8246 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8251 C---------------------------------------
8252 SUBROUTINE MATMAT2(A1,A2,A3)
8253 implicit real*8 (a-h,o-z)
8254 include 'DIMENSIONS'
8255 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8256 c DIMENSION AI3(2,2)
8260 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8266 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8267 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8268 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8269 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8277 c-------------------------------------------------------------------------
8278 double precision function scalar2(u,v)
8280 double precision u(2),v(2)
8283 scalar2=u(1)*v(1)+u(2)*v(2)
8287 C-----------------------------------------------------------------------------
8289 subroutine transpose2(a,at)
8291 double precision a(2,2),at(2,2)
8298 c--------------------------------------------------------------------------
8299 subroutine transpose(n,a,at)
8302 double precision a(n,n),at(n,n)
8310 C---------------------------------------------------------------------------
8311 subroutine prodmat3(a1,a2,kk,transp,prod)
8314 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8316 crc double precision auxmat(2,2),prod_(2,2)
8319 crc call transpose2(kk(1,1),auxmat(1,1))
8320 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8321 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8323 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8324 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8325 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8326 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8327 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8328 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8329 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8330 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8333 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8334 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8336 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8337 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8338 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8339 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8340 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8341 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8342 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8343 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8346 c call transpose2(a2(1,1),a2t(1,1))
8349 crc print *,((prod_(i,j),i=1,2),j=1,2)
8350 crc print *,((prod(i,j),i=1,2),j=1,2)
8354 C-----------------------------------------------------------------------------
8355 double precision function scalar(u,v)
8357 double precision u(3),v(3)
8367 C-----------------------------------------------------------------------
8368 double precision function sscale(r)
8369 double precision r,gamm
8370 include "COMMON.SPLITELE"
8371 if(r.lt.r_cut-rlamb) then
8373 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8374 gamm=(r-(r_cut-rlamb))/rlamb
8375 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8381 C-----------------------------------------------------------------------
8382 C-----------------------------------------------------------------------
8383 double precision function sscagrad(r)
8384 double precision r,gamm
8385 include "COMMON.SPLITELE"
8386 if(r.lt.r_cut-rlamb) then
8388 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8389 gamm=(r-(r_cut-rlamb))/rlamb
8390 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8396 C-----------------------------------------------------------------------
8397 C first for shielding is setting of function of side-chains
8398 subroutine set_shield_fac2
8399 implicit real*8 (a-h,o-z)
8400 include 'DIMENSIONS'
8401 include 'COMMON.CHAIN'
8402 include 'COMMON.DERIV'
8403 include 'COMMON.IOUNITS'
8404 include 'COMMON.SHIELD'
8405 include 'COMMON.INTERACT'
8406 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8407 double precision div77_81/0.974996043d0/,
8408 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8410 C the vector between center of side_chain and peptide group
8411 double precision pep_side(3),long,side_calf(3),
8412 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8413 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8414 C the line belowe needs to be changed for FGPROC>1
8416 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8418 Cif there two consequtive dummy atoms there is no peptide group between them
8419 C the line below has to be changed for FGPROC>1
8422 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8426 C first lets set vector conecting the ithe side-chain with kth side-chain
8427 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8429 C and vector conecting the side-chain with its proper calfa
8430 side_calf(j)=c(j,k+nres)-c(j,k)
8431 C side_calf(j)=2.0d0
8432 pept_group(j)=c(j,i)-c(j,i+1)
8433 C lets have their lenght
8434 dist_pep_side=pep_side(j)**2+dist_pep_side
8435 dist_side_calf=dist_side_calf+side_calf(j)**2
8436 dist_pept_group=dist_pept_group+pept_group(j)**2
8438 dist_pep_side=dsqrt(dist_pep_side)
8439 dist_pept_group=dsqrt(dist_pept_group)
8440 dist_side_calf=dsqrt(dist_side_calf)
8442 pep_side_norm(j)=pep_side(j)/dist_pep_side
8443 side_calf_norm(j)=dist_side_calf
8445 C now sscale fraction
8446 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8447 C print *,buff_shield,"buff"
8449 if (sh_frac_dist.le.0.0) cycle
8450 C If we reach here it means that this side chain reaches the shielding sphere
8451 C Lets add him to the list for gradient
8452 ishield_list(i)=ishield_list(i)+1
8453 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8454 C this list is essential otherwise problem would be O3
8455 shield_list(ishield_list(i),i)=k
8456 C Lets have the sscale value
8457 if (sh_frac_dist.gt.1.0) then
8458 scale_fac_dist=1.0d0
8460 sh_frac_dist_grad(j)=0.0d0
8463 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8464 & *(2.0d0*sh_frac_dist-3.0d0)
8465 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
8466 & /dist_pep_side/buff_shield*0.5d0
8467 C remember for the final gradient multiply sh_frac_dist_grad(j)
8468 C for side_chain by factor -2 !
8470 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8471 C sh_frac_dist_grad(j)=0.0d0
8472 C scale_fac_dist=1.0d0
8473 C print *,"jestem",scale_fac_dist,fac_help_scale,
8474 C & sh_frac_dist_grad(j)
8477 C this is what is now we have the distance scaling now volume...
8478 short=short_r_sidechain(itype(k))
8479 long=long_r_sidechain(itype(k))
8480 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
8481 sinthet=short/dist_pep_side*costhet
8485 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
8486 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
8487 C & -short/dist_pep_side**2/costhet)
8490 costhet_grad(j)=costhet_fac*pep_side(j)
8492 C remember for the final gradient multiply costhet_grad(j)
8493 C for side_chain by factor -2 !
8494 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8495 C pep_side0pept_group is vector multiplication
8496 pep_side0pept_group=0.0d0
8498 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8500 cosalfa=(pep_side0pept_group/
8501 & (dist_pep_side*dist_side_calf))
8502 fac_alfa_sin=1.0d0-cosalfa**2
8503 fac_alfa_sin=dsqrt(fac_alfa_sin)
8504 rkprim=fac_alfa_sin*(long-short)+short
8508 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
8510 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
8511 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
8515 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8516 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8517 &*(long-short)/fac_alfa_sin*cosalfa/
8518 &((dist_pep_side*dist_side_calf))*
8519 &((side_calf(j))-cosalfa*
8520 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8521 C cosphi_grad_long(j)=0.0d0
8522 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8523 &*(long-short)/fac_alfa_sin*cosalfa
8524 &/((dist_pep_side*dist_side_calf))*
8526 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8527 C cosphi_grad_loc(j)=0.0d0
8529 C print *,sinphi,sinthet
8530 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
8533 C now the gradient...
8535 grad_shield(j,i)=grad_shield(j,i)
8536 C gradient po skalowaniu
8537 & +(sh_frac_dist_grad(j)*VofOverlap
8538 C gradient po costhet
8539 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
8540 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8541 & sinphi/sinthet*costhet*costhet_grad(j)
8542 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8544 C grad_shield_side is Cbeta sidechain gradient
8545 grad_shield_side(j,ishield_list(i),i)=
8546 & (sh_frac_dist_grad(j)*-2.0d0
8548 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8549 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
8550 & sinphi/sinthet*costhet*costhet_grad(j)
8551 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
8554 grad_shield_loc(j,ishield_list(i),i)=
8555 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
8556 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
8557 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
8561 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8563 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
8564 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8568 C first for shielding is setting of function of side-chains
8569 subroutine set_shield_fac
8570 implicit real*8 (a-h,o-z)
8571 include 'DIMENSIONS'
8572 include 'COMMON.CHAIN'
8573 include 'COMMON.DERIV'
8574 include 'COMMON.IOUNITS'
8575 include 'COMMON.SHIELD'
8576 include 'COMMON.INTERACT'
8577 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8578 double precision div77_81/0.974996043d0/,
8579 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8581 C the vector between center of side_chain and peptide group
8582 double precision pep_side(3),long,side_calf(3),
8583 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8584 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8585 C the line belowe needs to be changed for FGPROC>1
8587 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8589 Cif there two consequtive dummy atoms there is no peptide group between them
8590 C the line below has to be changed for FGPROC>1
8593 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8597 C first lets set vector conecting the ithe side-chain with kth side-chain
8598 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8600 C and vector conecting the side-chain with its proper calfa
8601 side_calf(j)=c(j,k+nres)-c(j,k)
8602 C side_calf(j)=2.0d0
8603 pept_group(j)=c(j,i)-c(j,i+1)
8604 C lets have their lenght
8605 dist_pep_side=pep_side(j)**2+dist_pep_side
8606 dist_side_calf=dist_side_calf+side_calf(j)**2
8607 dist_pept_group=dist_pept_group+pept_group(j)**2
8609 dist_pep_side=dsqrt(dist_pep_side)
8610 dist_pept_group=dsqrt(dist_pept_group)
8611 dist_side_calf=dsqrt(dist_side_calf)
8613 pep_side_norm(j)=pep_side(j)/dist_pep_side
8614 side_calf_norm(j)=dist_side_calf
8616 C now sscale fraction
8617 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8618 C print *,buff_shield,"buff"
8620 if (sh_frac_dist.le.0.0) cycle
8621 C If we reach here it means that this side chain reaches the shielding sphere
8622 C Lets add him to the list for gradient
8623 ishield_list(i)=ishield_list(i)+1
8624 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8625 C this list is essential otherwise problem would be O3
8626 shield_list(ishield_list(i),i)=k
8627 C Lets have the sscale value
8628 if (sh_frac_dist.gt.1.0) then
8629 scale_fac_dist=1.0d0
8631 sh_frac_dist_grad(j)=0.0d0
8634 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8635 & *(2.0*sh_frac_dist-3.0d0)
8636 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8637 & /dist_pep_side/buff_shield*0.5
8638 C remember for the final gradient multiply sh_frac_dist_grad(j)
8639 C for side_chain by factor -2 !
8641 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8642 C print *,"jestem",scale_fac_dist,fac_help_scale,
8643 C & sh_frac_dist_grad(j)
8646 C if ((i.eq.3).and.(k.eq.2)) then
8647 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8651 C this is what is now we have the distance scaling now volume...
8652 short=short_r_sidechain(itype(k))
8653 long=long_r_sidechain(itype(k))
8654 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8657 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8660 costhet_grad(j)=costhet_fac*pep_side(j)
8662 C remember for the final gradient multiply costhet_grad(j)
8663 C for side_chain by factor -2 !
8664 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8665 C pep_side0pept_group is vector multiplication
8666 pep_side0pept_group=0.0
8668 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8670 cosalfa=(pep_side0pept_group/
8671 & (dist_pep_side*dist_side_calf))
8672 fac_alfa_sin=1.0-cosalfa**2
8673 fac_alfa_sin=dsqrt(fac_alfa_sin)
8674 rkprim=fac_alfa_sin*(long-short)+short
8676 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8677 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8680 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8681 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8682 &*(long-short)/fac_alfa_sin*cosalfa/
8683 &((dist_pep_side*dist_side_calf))*
8684 &((side_calf(j))-cosalfa*
8685 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8687 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8688 &*(long-short)/fac_alfa_sin*cosalfa
8689 &/((dist_pep_side*dist_side_calf))*
8691 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8694 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8697 C now the gradient...
8698 C grad_shield is gradient of Calfa for peptide groups
8699 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8701 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8702 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8704 grad_shield(j,i)=grad_shield(j,i)
8705 C gradient po skalowaniu
8706 & +(sh_frac_dist_grad(j)
8707 C gradient po costhet
8708 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8709 &-scale_fac_dist*(cosphi_grad_long(j))
8710 &/(1.0-cosphi) )*div77_81
8712 C grad_shield_side is Cbeta sidechain gradient
8713 grad_shield_side(j,ishield_list(i),i)=
8714 & (sh_frac_dist_grad(j)*-2.0d0
8715 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
8716 & +scale_fac_dist*(cosphi_grad_long(j))
8717 & *2.0d0/(1.0-cosphi))
8718 & *div77_81*VofOverlap
8720 grad_shield_loc(j,ishield_list(i),i)=
8721 & scale_fac_dist*cosphi_grad_loc(j)
8722 & *2.0d0/(1.0-cosphi)
8723 & *div77_81*VofOverlap
8725 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8727 fac_shield(i)=VolumeTotal*div77_81+div4_81
8728 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8732 C--------------------------------------------------------------------------