1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 include 'COMMON.SHIELD'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
49 C write(iout,*) 'po elektostatyce'
51 C Calculate electrostatic (H-bonding) energy of the main chain.
54 if (shield_mode.eq.1) then
56 else if (shield_mode.eq.2) then
59 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
60 C write(iout,*) 'po eelec'
62 C Calculate excluded-volume interaction energy between peptide groups
65 call escp(evdw2,evdw2_14)
67 c Calculate the bond-stretching energy
71 C write (iout,*) "estr",estr
73 C Calculate the disulfide-bridge and other energy and the contributions
74 C from other distance constraints.
75 cd print *,'Calling EHPB'
77 cd print *,'EHPB exitted succesfully.'
79 C Calculate the virtual-bond-angle energy.
81 C print *,'Bend energy finished.'
82 call ebend(ebe,ethetacnstr)
83 cd print *,'Bend energy finished.'
85 C Calculate the SC local energy.
88 C print *,'SCLOC energy finished.'
90 C Calculate the virtual-bond torsional energy.
92 cd print *,'nterm=',nterm
93 call etor(etors,edihcnstr,fact(1))
95 C 6/23/01 Calculate double-torsional energy
97 call etor_d(etors_d,fact(2))
99 C 21/5/07 Calculate local sicdechain correlation energy
101 call eback_sc_corr(esccor)
103 if (wliptran.gt.0) then
104 call Eliptransfer(eliptran)
108 C 12/1/95 Multi-body terms
112 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
113 & .or. wturn6.gt.0.0d0) then
114 c print *,"calling multibody_eello"
115 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
116 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
117 c print *,ecorr,ecorr5,ecorr6,eturn6
124 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
125 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
127 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
129 if (shield_mode.gt.0) then
130 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
132 & +fact(1)*wvdwpp*evdw1
133 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
134 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
135 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
136 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
137 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
138 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
141 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
143 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
144 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
145 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
146 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
147 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
148 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
152 if (shield_mode.gt.0) then
153 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
154 & +welec*fact(1)*(ees+evdw1)
155 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
156 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
157 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
158 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
159 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
160 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
163 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
164 & +welec*fact(1)*(ees+evdw1)
165 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
166 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
167 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
168 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
169 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
170 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
177 energia(2)=evdw2-evdw2_14
194 energia(8)=eello_turn3
195 energia(9)=eello_turn4
204 energia(20)=edihcnstr
206 energia(24)=ethetacnstr
211 if (isnan(etot).ne.0) energia(0)=1.0d+99
213 if (isnan(etot)) energia(0)=1.0d+99
218 idumm=proc_proc(etot,i)
220 call proc_proc(etot,i)
222 if(i.eq.1)energia(0)=1.0d+99
229 call enerprint(energia,fact)
234 C Sum up the components of the Cartesian gradient.
239 if (shield_mode.eq.0) then
240 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
241 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
243 & wstrain*ghpbc(j,i)+
244 & wcorr*fact(3)*gradcorr(j,i)+
245 & wel_loc*fact(2)*gel_loc(j,i)+
246 & wturn3*fact(2)*gcorr3_turn(j,i)+
247 & wturn4*fact(3)*gcorr4_turn(j,i)+
248 & wcorr5*fact(4)*gradcorr5(j,i)+
249 & wcorr6*fact(5)*gradcorr6(j,i)+
250 & wturn6*fact(5)*gcorr6_turn(j,i)+
251 & wsccor*fact(2)*gsccorc(j,i)
252 & +wliptran*gliptranc(j,i)
253 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
255 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
256 & wsccor*fact(2)*gsccorx(j,i)
257 & +wliptran*gliptranx(j,i)
259 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
260 & +fact(1)*wscp*gvdwc_scp(j,i)+
261 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
263 & wstrain*ghpbc(j,i)+
264 & wcorr*fact(3)*gradcorr(j,i)+
265 & wel_loc*fact(2)*gel_loc(j,i)+
266 & wturn3*fact(2)*gcorr3_turn(j,i)+
267 & wturn4*fact(3)*gcorr4_turn(j,i)+
268 & wcorr5*fact(4)*gradcorr5(j,i)+
269 & wcorr6*fact(5)*gradcorr6(j,i)+
270 & wturn6*fact(5)*gcorr6_turn(j,i)+
271 & wsccor*fact(2)*gsccorc(j,i)
272 & +wliptran*gliptranc(j,i)
273 & +welec*gshieldc(j,i)
274 & +welec*gshieldc_loc(j,i)
275 & +wcorr*gshieldc_ec(j,i)
276 & +wcorr*gshieldc_loc_ec(j,i)
277 & +wturn3*gshieldc_t3(j,i)
278 & +wturn3*gshieldc_loc_t3(j,i)
279 & +wturn4*gshieldc_t4(j,i)
280 & +wturn4*gshieldc_loc_t4(j,i)
281 & +wel_loc*gshieldc_ll(j,i)
282 & +wel_loc*gshieldc_loc_ll(j,i)
284 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
285 & +fact(1)*wscp*gradx_scp(j,i)+
287 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
288 & wsccor*fact(2)*gsccorx(j,i)
289 & +wliptran*gliptranx(j,i)
290 & +welec*gshieldx(j,i)
291 & +wcorr*gshieldx_ec(j,i)
292 & +wturn3*gshieldx_t3(j,i)
293 & +wturn4*gshieldx_t4(j,i)
294 & +wel_loc*gshieldx_ll(j,i)
302 if (shield_mode.eq.0) then
303 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
304 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
306 & wcorr*fact(3)*gradcorr(j,i)+
307 & wel_loc*fact(2)*gel_loc(j,i)+
308 & wturn3*fact(2)*gcorr3_turn(j,i)+
309 & wturn4*fact(3)*gcorr4_turn(j,i)+
310 & wcorr5*fact(4)*gradcorr5(j,i)+
311 & wcorr6*fact(5)*gradcorr6(j,i)+
312 & wturn6*fact(5)*gcorr6_turn(j,i)+
313 & wsccor*fact(2)*gsccorc(j,i)
314 & +wliptran*gliptranc(j,i)
315 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
317 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
318 & wsccor*fact(1)*gsccorx(j,i)
319 & +wliptran*gliptranx(j,i)
321 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
322 & fact(1)*wscp*gvdwc_scp(j,i)+
323 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
325 & wcorr*fact(3)*gradcorr(j,i)+
326 & wel_loc*fact(2)*gel_loc(j,i)+
327 & wturn3*fact(2)*gcorr3_turn(j,i)+
328 & wturn4*fact(3)*gcorr4_turn(j,i)+
329 & wcorr5*fact(4)*gradcorr5(j,i)+
330 & wcorr6*fact(5)*gradcorr6(j,i)+
331 & wturn6*fact(5)*gcorr6_turn(j,i)+
332 & wsccor*fact(2)*gsccorc(j,i)
333 & +wliptran*gliptranc(j,i)
334 & +welec*gshieldc(j,i)
335 & +welec*gshieldc_loc(j,i)
336 & +wcorr*gshieldc_ec(j,i)
337 & +wcorr*gshieldc_loc_ec(j,i)
338 & +wturn3*gshieldc_t3(j,i)
339 & +wturn3*gshieldc_loc_t3(j,i)
340 & +wturn4*gshieldc_t4(j,i)
341 & +wturn4*gshieldc_loc_t4(j,i)
342 & +wel_loc*gshieldc_ll(j,i)
343 & +wel_loc*gshieldc_loc_ll(j,i)
345 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
346 & fact(1)*wscp*gradx_scp(j,i)+
348 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
349 & wsccor*fact(1)*gsccorx(j,i)
350 & +wliptran*gliptranx(j,i)
351 & +welec*gshieldx(j,i)
352 & +wcorr*gshieldx_ec(j,i)
353 & +wturn3*gshieldx_t3(j,i)
354 & +wturn4*gshieldx_t4(j,i)
355 & +wel_loc*gshieldx_ll(j,i)
364 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
365 & +wcorr5*fact(4)*g_corr5_loc(i)
366 & +wcorr6*fact(5)*g_corr6_loc(i)
367 & +wturn4*fact(3)*gel_loc_turn4(i)
368 & +wturn3*fact(2)*gel_loc_turn3(i)
369 & +wturn6*fact(5)*gel_loc_turn6(i)
370 & +wel_loc*fact(2)*gel_loc_loc(i)
371 c & +wsccor*fact(1)*gsccor_loc(i)
372 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
375 if (dyn_ss) call dyn_set_nss
378 C------------------------------------------------------------------------
379 subroutine enerprint(energia,fact)
380 implicit real*8 (a-h,o-z)
382 include 'DIMENSIONS.ZSCOPT'
383 include 'COMMON.IOUNITS'
384 include 'COMMON.FFIELD'
385 include 'COMMON.SBRIDGE'
386 double precision energia(0:max_ene),fact(6)
388 evdw=energia(1)+fact(6)*energia(21)
390 evdw2=energia(2)+energia(17)
402 eello_turn3=energia(8)
403 eello_turn4=energia(9)
404 eello_turn6=energia(10)
411 edihcnstr=energia(20)
413 ethetacnstr=energia(24)
416 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
418 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
419 & etors_d,wtor_d*fact(2),ehpb,wstrain,
420 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
421 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
422 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
423 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
424 & eliptran,wliptran,etot
425 10 format (/'Virtual-chain energies:'//
426 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
427 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
428 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
429 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
430 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
431 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
432 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
433 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
434 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
435 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
436 & ' (SS bridges & dist. cnstr.)'/
437 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
438 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
439 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
440 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
441 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
442 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
443 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
444 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
445 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
446 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
447 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
448 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
449 & 'ETOT= ',1pE16.6,' (total)')
451 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
452 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
453 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
454 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
455 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
456 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
457 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot
458 10 format (/'Virtual-chain energies:'//
459 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
460 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
461 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
462 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
463 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
464 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
465 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
466 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
467 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
468 & ' (SS bridges & dist. cnstr.)'/
469 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
470 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
471 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
472 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
473 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
474 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
475 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
476 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
477 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
478 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
479 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
480 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
481 & 'ETOT= ',1pE16.6,' (total)')
485 C-----------------------------------------------------------------------
486 subroutine elj(evdw,evdw_t)
488 C This subroutine calculates the interaction energy of nonbonded side chains
489 C assuming the LJ potential of interaction.
491 implicit real*8 (a-h,o-z)
493 include 'DIMENSIONS.ZSCOPT'
494 include "DIMENSIONS.COMPAR"
495 parameter (accur=1.0d-10)
498 include 'COMMON.LOCAL'
499 include 'COMMON.CHAIN'
500 include 'COMMON.DERIV'
501 include 'COMMON.INTERACT'
502 include 'COMMON.TORSION'
503 include 'COMMON.ENEPS'
504 include 'COMMON.SBRIDGE'
505 include 'COMMON.NAMES'
506 include 'COMMON.IOUNITS'
507 include 'COMMON.CONTACTS'
511 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
515 eneps_temp(j,i)=0.0d0
524 if (itypi.eq.ntyp1) cycle
525 itypi1=iabs(itype(i+1))
532 C Calculate SC interaction energy.
535 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
536 cd & 'iend=',iend(i,iint)
537 do j=istart(i,iint),iend(i,iint)
539 if (itypj.eq.ntyp1) cycle
543 C Change 12/1/95 to calculate four-body interactions
544 rij=xj*xj+yj*yj+zj*zj
546 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
547 eps0ij=eps(itypi,itypj)
552 ij=icant(itypi,itypj)
554 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
555 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
558 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
559 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
560 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
561 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
562 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
563 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
564 if (bb.gt.0.0d0) then
571 C Calculate the components of the gradient in DC and X
573 fac=-rrij*(e1+evdwij)
578 gvdwx(k,i)=gvdwx(k,i)-gg(k)
579 gvdwx(k,j)=gvdwx(k,j)+gg(k)
583 gvdwc(l,k)=gvdwc(l,k)+gg(l)
588 C 12/1/95, revised on 5/20/97
590 C Calculate the contact function. The ith column of the array JCONT will
591 C contain the numbers of atoms that make contacts with the atom I (of numbers
592 C greater than I). The arrays FACONT and GACONT will contain the values of
593 C the contact function and its derivative.
595 C Uncomment next line, if the correlation interactions include EVDW explicitly.
596 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
597 C Uncomment next line, if the correlation interactions are contact function only
598 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
600 sigij=sigma(itypi,itypj)
601 r0ij=rs0(itypi,itypj)
603 C Check whether the SC's are not too far to make a contact.
606 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
607 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
609 if (fcont.gt.0.0D0) then
610 C If the SC-SC distance if close to sigma, apply spline.
611 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
612 cAdam & fcont1,fprimcont1)
613 cAdam fcont1=1.0d0-fcont1
614 cAdam if (fcont1.gt.0.0d0) then
615 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
616 cAdam fcont=fcont*fcont1
618 C Uncomment following 4 lines to have the geometric average of the epsilon0's
619 cga eps0ij=1.0d0/dsqrt(eps0ij)
621 cga gg(k)=gg(k)*eps0ij
623 cga eps0ij=-evdwij*eps0ij
624 C Uncomment for AL's type of SC correlation interactions.
626 num_conti=num_conti+1
628 facont(num_conti,i)=fcont*eps0ij
629 fprimcont=eps0ij*fprimcont/rij
631 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
632 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
633 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
634 C Uncomment following 3 lines for Skolnick's type of SC correlation.
635 gacont(1,num_conti,i)=-fprimcont*xj
636 gacont(2,num_conti,i)=-fprimcont*yj
637 gacont(3,num_conti,i)=-fprimcont*zj
638 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
639 cd write (iout,'(2i3,3f10.5)')
640 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
646 num_cont(i)=num_conti
651 gvdwc(j,i)=expon*gvdwc(j,i)
652 gvdwx(j,i)=expon*gvdwx(j,i)
656 C******************************************************************************
660 C To save time, the factor of EXPON has been extracted from ALL components
661 C of GVDWC and GRADX. Remember to multiply them by this factor before further
664 C******************************************************************************
667 C-----------------------------------------------------------------------------
668 subroutine eljk(evdw,evdw_t)
670 C This subroutine calculates the interaction energy of nonbonded side chains
671 C assuming the LJK potential of interaction.
673 implicit real*8 (a-h,o-z)
675 include 'DIMENSIONS.ZSCOPT'
676 include "DIMENSIONS.COMPAR"
679 include 'COMMON.LOCAL'
680 include 'COMMON.CHAIN'
681 include 'COMMON.DERIV'
682 include 'COMMON.INTERACT'
683 include 'COMMON.ENEPS'
684 include 'COMMON.IOUNITS'
685 include 'COMMON.NAMES'
690 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
693 eneps_temp(j,i)=0.0d0
700 if (itypi.eq.ntyp1) cycle
701 itypi1=iabs(itype(i+1))
706 C Calculate SC interaction energy.
709 do j=istart(i,iint),iend(i,iint)
711 if (itypj.eq.ntyp1) cycle
715 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
717 e_augm=augm(itypi,itypj)*fac_augm
720 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
721 fac=r_shift_inv**expon
725 ij=icant(itypi,itypj)
726 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
727 & /dabs(eps(itypi,itypj))
728 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
729 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
730 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
731 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
732 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
733 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
734 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
735 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
736 if (bb.gt.0.0d0) then
743 C Calculate the components of the gradient in DC and X
745 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
750 gvdwx(k,i)=gvdwx(k,i)-gg(k)
751 gvdwx(k,j)=gvdwx(k,j)+gg(k)
755 gvdwc(l,k)=gvdwc(l,k)+gg(l)
765 gvdwc(j,i)=expon*gvdwc(j,i)
766 gvdwx(j,i)=expon*gvdwx(j,i)
772 C-----------------------------------------------------------------------------
773 subroutine ebp(evdw,evdw_t)
775 C This subroutine calculates the interaction energy of nonbonded side chains
776 C assuming the Berne-Pechukas potential of interaction.
778 implicit real*8 (a-h,o-z)
780 include 'DIMENSIONS.ZSCOPT'
781 include "DIMENSIONS.COMPAR"
784 include 'COMMON.LOCAL'
785 include 'COMMON.CHAIN'
786 include 'COMMON.DERIV'
787 include 'COMMON.NAMES'
788 include 'COMMON.INTERACT'
789 include 'COMMON.ENEPS'
790 include 'COMMON.IOUNITS'
791 include 'COMMON.CALC'
793 c double precision rrsave(maxdim)
799 eneps_temp(j,i)=0.0d0
804 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
805 c if (icall.eq.0) then
813 if (itypi.eq.ntyp1) cycle
814 itypi1=iabs(itype(i+1))
818 dxi=dc_norm(1,nres+i)
819 dyi=dc_norm(2,nres+i)
820 dzi=dc_norm(3,nres+i)
821 dsci_inv=vbld_inv(i+nres)
823 C Calculate SC interaction energy.
826 do j=istart(i,iint),iend(i,iint)
829 if (itypj.eq.ntyp1) cycle
830 dscj_inv=vbld_inv(j+nres)
831 chi1=chi(itypi,itypj)
832 chi2=chi(itypj,itypi)
839 alf12=0.5D0*(alf1+alf2)
840 C For diagnostics only!!!
853 dxj=dc_norm(1,nres+j)
854 dyj=dc_norm(2,nres+j)
855 dzj=dc_norm(3,nres+j)
856 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
857 cd if (icall.eq.0) then
863 C Calculate the angle-dependent terms of energy & contributions to derivatives.
865 C Calculate whole angle-dependent part of epsilon and contributions
867 fac=(rrij*sigsq)**expon2
870 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
871 eps2der=evdwij*eps3rt
872 eps3der=evdwij*eps2rt
873 evdwij=evdwij*eps2rt*eps3rt
874 ij=icant(itypi,itypj)
875 aux=eps1*eps2rt**2*eps3rt**2
876 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
877 & /dabs(eps(itypi,itypj))
878 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
879 if (bb.gt.0.0d0) then
886 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
888 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
889 & restyp(itypi),i,restyp(itypj),j,
890 & epsi,sigm,chi1,chi2,chip1,chip2,
891 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
892 & om1,om2,om12,1.0D0/dsqrt(rrij),
895 C Calculate gradient components.
896 e1=e1*eps1*eps2rt**2*eps3rt**2
897 fac=-expon*(e1+evdwij)
900 C Calculate radial part of the gradient
904 C Calculate the angular part of the gradient and sum add the contributions
905 C to the appropriate components of the Cartesian gradient.
914 C-----------------------------------------------------------------------------
915 subroutine egb(evdw,evdw_t)
917 C This subroutine calculates the interaction energy of nonbonded side chains
918 C assuming the Gay-Berne potential of interaction.
920 implicit real*8 (a-h,o-z)
922 include 'DIMENSIONS.ZSCOPT'
923 include "DIMENSIONS.COMPAR"
926 include 'COMMON.LOCAL'
927 include 'COMMON.CHAIN'
928 include 'COMMON.DERIV'
929 include 'COMMON.NAMES'
930 include 'COMMON.INTERACT'
931 include 'COMMON.ENEPS'
932 include 'COMMON.IOUNITS'
933 include 'COMMON.CALC'
934 include 'COMMON.SBRIDGE'
937 integer icant,xshift,yshift,zshift
941 eneps_temp(j,i)=0.0d0
944 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
948 c if (icall.gt.0) lprn=.true.
952 if (itypi.eq.ntyp1) cycle
953 itypi1=iabs(itype(i+1))
957 C returning the ith atom to box
959 if (xi.lt.0) xi=xi+boxxsize
961 if (yi.lt.0) yi=yi+boxysize
963 if (zi.lt.0) zi=zi+boxzsize
964 if ((zi.gt.bordlipbot)
965 &.and.(zi.lt.bordliptop)) then
966 C the energy transfer exist
967 if (zi.lt.buflipbot) then
968 C what fraction I am in
970 & ((zi-bordlipbot)/lipbufthick)
971 C lipbufthick is thickenes of lipid buffore
972 sslipi=sscalelip(fracinbuf)
973 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
974 elseif (zi.gt.bufliptop) then
975 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
976 sslipi=sscalelip(fracinbuf)
977 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
987 dxi=dc_norm(1,nres+i)
988 dyi=dc_norm(2,nres+i)
989 dzi=dc_norm(3,nres+i)
990 dsci_inv=vbld_inv(i+nres)
992 C Calculate SC interaction energy.
995 do j=istart(i,iint),iend(i,iint)
996 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
997 call dyn_ssbond_ene(i,j,evdwij)
999 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1000 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1001 C triple bond artifac removal
1002 do k=j+1,iend(i,iint)
1003 C search over all next residues
1004 if (dyn_ss_mask(k)) then
1005 C check if they are cysteins
1006 C write(iout,*) 'k=',k
1007 call triple_ssbond_ene(i,j,k,evdwij)
1008 C call the energy function that removes the artifical triple disulfide
1009 C bond the soubroutine is located in ssMD.F
1011 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1012 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1013 endif!dyn_ss_mask(k)
1017 itypj=iabs(itype(j))
1018 if (itypj.eq.ntyp1) cycle
1019 dscj_inv=vbld_inv(j+nres)
1020 sig0ij=sigma(itypi,itypj)
1021 chi1=chi(itypi,itypj)
1022 chi2=chi(itypj,itypi)
1029 alf12=0.5D0*(alf1+alf2)
1030 C For diagnostics only!!!
1043 C returning jth atom to box
1045 if (xj.lt.0) xj=xj+boxxsize
1047 if (yj.lt.0) yj=yj+boxysize
1049 if (zj.lt.0) zj=zj+boxzsize
1050 if ((zj.gt.bordlipbot)
1051 &.and.(zj.lt.bordliptop)) then
1052 C the energy transfer exist
1053 if (zj.lt.buflipbot) then
1054 C what fraction I am in
1056 & ((zj-bordlipbot)/lipbufthick)
1057 C lipbufthick is thickenes of lipid buffore
1058 sslipj=sscalelip(fracinbuf)
1059 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1060 elseif (zj.gt.bufliptop) then
1061 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1062 sslipj=sscalelip(fracinbuf)
1063 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1072 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1073 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1074 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1075 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1076 C if (aa.ne.aa_aq(itypi,itypj)) then
1078 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1079 C & bb_aq(itypi,itypj)-bb,
1083 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1084 C checking the distance
1085 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1090 C finding the closest
1094 xj=xj_safe+xshift*boxxsize
1095 yj=yj_safe+yshift*boxysize
1096 zj=zj_safe+zshift*boxzsize
1097 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1098 if(dist_temp.lt.dist_init) then
1108 if (subchap.eq.1) then
1118 dxj=dc_norm(1,nres+j)
1119 dyj=dc_norm(2,nres+j)
1120 dzj=dc_norm(3,nres+j)
1121 c write (iout,*) i,j,xj,yj,zj
1122 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1124 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1125 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1126 if (sss.le.0.0) cycle
1127 C Calculate angle-dependent terms of energy and contributions to their
1132 sig=sig0ij*dsqrt(sigsq)
1133 rij_shift=1.0D0/rij-sig+sig0ij
1134 C I hate to put IF's in the loops, but here don't have another choice!!!!
1135 if (rij_shift.le.0.0D0) then
1140 c---------------------------------------------------------------
1141 rij_shift=1.0D0/rij_shift
1142 fac=rij_shift**expon
1145 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1146 eps2der=evdwij*eps3rt
1147 eps3der=evdwij*eps2rt
1148 evdwij=evdwij*eps2rt*eps3rt
1150 evdw=evdw+evdwij*sss
1152 evdw_t=evdw_t+evdwij*sss
1154 ij=icant(itypi,itypj)
1155 aux=eps1*eps2rt**2*eps3rt**2
1156 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1157 & /dabs(eps(itypi,itypj))
1158 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1159 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1160 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1161 c & aux*e2/eps(itypi,itypj)
1163 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1167 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1168 & restyp(itypi),i,restyp(itypj),j,
1169 & epsi,sigm,chi1,chi2,chip1,chip2,
1170 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1171 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1173 write (iout,*) "partial sum", evdw, evdw_t
1178 C Calculate gradient components.
1179 e1=e1*eps1*eps2rt**2*eps3rt**2
1180 fac=-expon*(e1+evdwij)*rij_shift
1183 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1184 C Calculate the radial part of the gradient
1188 C Calculate angular part of the gradient.
1191 C write(iout,*) "partial sum", evdw, evdw_t
1198 C-----------------------------------------------------------------------------
1199 subroutine egbv(evdw,evdw_t)
1201 C This subroutine calculates the interaction energy of nonbonded side chains
1202 C assuming the Gay-Berne-Vorobjev potential of interaction.
1204 implicit real*8 (a-h,o-z)
1205 include 'DIMENSIONS'
1206 include 'DIMENSIONS.ZSCOPT'
1207 include "DIMENSIONS.COMPAR"
1208 include 'COMMON.GEO'
1209 include 'COMMON.VAR'
1210 include 'COMMON.LOCAL'
1211 include 'COMMON.CHAIN'
1212 include 'COMMON.DERIV'
1213 include 'COMMON.NAMES'
1214 include 'COMMON.INTERACT'
1215 include 'COMMON.ENEPS'
1216 include 'COMMON.IOUNITS'
1217 include 'COMMON.CALC'
1218 common /srutu/ icall
1224 eneps_temp(j,i)=0.0d0
1229 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1232 c if (icall.gt.0) lprn=.true.
1234 do i=iatsc_s,iatsc_e
1235 itypi=iabs(itype(i))
1236 if (itypi.eq.ntyp1) cycle
1237 itypi1=iabs(itype(i+1))
1241 dxi=dc_norm(1,nres+i)
1242 dyi=dc_norm(2,nres+i)
1243 dzi=dc_norm(3,nres+i)
1244 dsci_inv=vbld_inv(i+nres)
1246 C Calculate SC interaction energy.
1248 do iint=1,nint_gr(i)
1249 do j=istart(i,iint),iend(i,iint)
1251 itypj=iabs(itype(j))
1252 if (itypj.eq.ntyp1) cycle
1253 dscj_inv=vbld_inv(j+nres)
1254 sig0ij=sigma(itypi,itypj)
1255 r0ij=r0(itypi,itypj)
1256 chi1=chi(itypi,itypj)
1257 chi2=chi(itypj,itypi)
1264 alf12=0.5D0*(alf1+alf2)
1265 C For diagnostics only!!!
1278 dxj=dc_norm(1,nres+j)
1279 dyj=dc_norm(2,nres+j)
1280 dzj=dc_norm(3,nres+j)
1281 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1283 C Calculate angle-dependent terms of energy and contributions to their
1287 sig=sig0ij*dsqrt(sigsq)
1288 rij_shift=1.0D0/rij-sig+r0ij
1289 C I hate to put IF's in the loops, but here don't have another choice!!!!
1290 if (rij_shift.le.0.0D0) then
1295 c---------------------------------------------------------------
1296 rij_shift=1.0D0/rij_shift
1297 fac=rij_shift**expon
1300 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1301 eps2der=evdwij*eps3rt
1302 eps3der=evdwij*eps2rt
1303 fac_augm=rrij**expon
1304 e_augm=augm(itypi,itypj)*fac_augm
1305 evdwij=evdwij*eps2rt*eps3rt
1306 if (bb.gt.0.0d0) then
1307 evdw=evdw+evdwij+e_augm
1309 evdw_t=evdw_t+evdwij+e_augm
1311 ij=icant(itypi,itypj)
1312 aux=eps1*eps2rt**2*eps3rt**2
1313 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1314 & /dabs(eps(itypi,itypj))
1315 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1316 c eneps_temp(ij)=eneps_temp(ij)
1317 c & +(evdwij+e_augm)/eps(itypi,itypj)
1319 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1320 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1321 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1322 c & restyp(itypi),i,restyp(itypj),j,
1323 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1324 c & chi1,chi2,chip1,chip2,
1325 c & eps1,eps2rt**2,eps3rt**2,
1326 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1330 C Calculate gradient components.
1331 e1=e1*eps1*eps2rt**2*eps3rt**2
1332 fac=-expon*(e1+evdwij)*rij_shift
1334 fac=rij*fac-2*expon*rrij*e_augm
1335 C Calculate the radial part of the gradient
1339 C Calculate angular part of the gradient.
1347 C-----------------------------------------------------------------------------
1348 subroutine sc_angular
1349 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1350 C om12. Called by ebp, egb, and egbv.
1352 include 'COMMON.CALC'
1356 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1357 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1358 om12=dxi*dxj+dyi*dyj+dzi*dzj
1360 C Calculate eps1(om12) and its derivative in om12
1361 faceps1=1.0D0-om12*chiom12
1362 faceps1_inv=1.0D0/faceps1
1363 eps1=dsqrt(faceps1_inv)
1364 C Following variable is eps1*deps1/dom12
1365 eps1_om12=faceps1_inv*chiom12
1366 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1371 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1372 sigsq=1.0D0-facsig*faceps1_inv
1373 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1374 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1375 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1376 C Calculate eps2 and its derivatives in om1, om2, and om12.
1379 chipom12=chip12*om12
1380 facp=1.0D0-om12*chipom12
1382 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1383 C Following variable is the square root of eps2
1384 eps2rt=1.0D0-facp1*facp_inv
1385 C Following three variables are the derivatives of the square root of eps
1386 C in om1, om2, and om12.
1387 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1388 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1389 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1390 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1391 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1392 C Calculate whole angle-dependent part of epsilon and contributions
1393 C to its derivatives
1396 C----------------------------------------------------------------------------
1398 implicit real*8 (a-h,o-z)
1399 include 'DIMENSIONS'
1400 include 'DIMENSIONS.ZSCOPT'
1401 include 'COMMON.CHAIN'
1402 include 'COMMON.DERIV'
1403 include 'COMMON.CALC'
1404 double precision dcosom1(3),dcosom2(3)
1405 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1406 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1407 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1408 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1410 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1411 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1414 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1417 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1418 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1419 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1420 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1421 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1422 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1425 C Calculate the components of the gradient in DC and X
1429 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1434 c------------------------------------------------------------------------------
1435 subroutine vec_and_deriv
1436 implicit real*8 (a-h,o-z)
1437 include 'DIMENSIONS'
1438 include 'DIMENSIONS.ZSCOPT'
1439 include 'COMMON.IOUNITS'
1440 include 'COMMON.GEO'
1441 include 'COMMON.VAR'
1442 include 'COMMON.LOCAL'
1443 include 'COMMON.CHAIN'
1444 include 'COMMON.VECTORS'
1445 include 'COMMON.DERIV'
1446 include 'COMMON.INTERACT'
1447 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1448 C Compute the local reference systems. For reference system (i), the
1449 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1450 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1452 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1453 if (i.eq.nres-1) then
1454 C Case of the last full residue
1455 C Compute the Z-axis
1456 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1457 costh=dcos(pi-theta(nres))
1458 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1463 C Compute the derivatives of uz
1465 uzder(2,1,1)=-dc_norm(3,i-1)
1466 uzder(3,1,1)= dc_norm(2,i-1)
1467 uzder(1,2,1)= dc_norm(3,i-1)
1469 uzder(3,2,1)=-dc_norm(1,i-1)
1470 uzder(1,3,1)=-dc_norm(2,i-1)
1471 uzder(2,3,1)= dc_norm(1,i-1)
1474 uzder(2,1,2)= dc_norm(3,i)
1475 uzder(3,1,2)=-dc_norm(2,i)
1476 uzder(1,2,2)=-dc_norm(3,i)
1478 uzder(3,2,2)= dc_norm(1,i)
1479 uzder(1,3,2)= dc_norm(2,i)
1480 uzder(2,3,2)=-dc_norm(1,i)
1483 C Compute the Y-axis
1486 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1489 C Compute the derivatives of uy
1492 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1493 & -dc_norm(k,i)*dc_norm(j,i-1)
1494 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1496 uyder(j,j,1)=uyder(j,j,1)-costh
1497 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1502 uygrad(l,k,j,i)=uyder(l,k,j)
1503 uzgrad(l,k,j,i)=uzder(l,k,j)
1507 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1508 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1509 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1510 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1514 C Compute the Z-axis
1515 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1516 costh=dcos(pi-theta(i+2))
1517 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1522 C Compute the derivatives of uz
1524 uzder(2,1,1)=-dc_norm(3,i+1)
1525 uzder(3,1,1)= dc_norm(2,i+1)
1526 uzder(1,2,1)= dc_norm(3,i+1)
1528 uzder(3,2,1)=-dc_norm(1,i+1)
1529 uzder(1,3,1)=-dc_norm(2,i+1)
1530 uzder(2,3,1)= dc_norm(1,i+1)
1533 uzder(2,1,2)= dc_norm(3,i)
1534 uzder(3,1,2)=-dc_norm(2,i)
1535 uzder(1,2,2)=-dc_norm(3,i)
1537 uzder(3,2,2)= dc_norm(1,i)
1538 uzder(1,3,2)= dc_norm(2,i)
1539 uzder(2,3,2)=-dc_norm(1,i)
1542 C Compute the Y-axis
1545 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1548 C Compute the derivatives of uy
1551 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1552 & -dc_norm(k,i)*dc_norm(j,i+1)
1553 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1555 uyder(j,j,1)=uyder(j,j,1)-costh
1556 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1561 uygrad(l,k,j,i)=uyder(l,k,j)
1562 uzgrad(l,k,j,i)=uzder(l,k,j)
1566 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1567 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1568 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1569 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1575 vbld_inv_temp(1)=vbld_inv(i+1)
1576 if (i.lt.nres-1) then
1577 vbld_inv_temp(2)=vbld_inv(i+2)
1579 vbld_inv_temp(2)=vbld_inv(i)
1584 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1585 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1593 C-----------------------------------------------------------------------------
1594 subroutine vec_and_deriv_test
1595 implicit real*8 (a-h,o-z)
1596 include 'DIMENSIONS'
1597 include 'DIMENSIONS.ZSCOPT'
1598 include 'COMMON.IOUNITS'
1599 include 'COMMON.GEO'
1600 include 'COMMON.VAR'
1601 include 'COMMON.LOCAL'
1602 include 'COMMON.CHAIN'
1603 include 'COMMON.VECTORS'
1604 dimension uyder(3,3,2),uzder(3,3,2)
1605 C Compute the local reference systems. For reference system (i), the
1606 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1607 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1609 if (i.eq.nres-1) then
1610 C Case of the last full residue
1611 C Compute the Z-axis
1612 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1613 costh=dcos(pi-theta(nres))
1614 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1615 c write (iout,*) 'fac',fac,
1616 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1617 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1621 C Compute the derivatives of uz
1623 uzder(2,1,1)=-dc_norm(3,i-1)
1624 uzder(3,1,1)= dc_norm(2,i-1)
1625 uzder(1,2,1)= dc_norm(3,i-1)
1627 uzder(3,2,1)=-dc_norm(1,i-1)
1628 uzder(1,3,1)=-dc_norm(2,i-1)
1629 uzder(2,3,1)= dc_norm(1,i-1)
1632 uzder(2,1,2)= dc_norm(3,i)
1633 uzder(3,1,2)=-dc_norm(2,i)
1634 uzder(1,2,2)=-dc_norm(3,i)
1636 uzder(3,2,2)= dc_norm(1,i)
1637 uzder(1,3,2)= dc_norm(2,i)
1638 uzder(2,3,2)=-dc_norm(1,i)
1640 C Compute the Y-axis
1642 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1645 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1646 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1647 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1649 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1652 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1653 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1656 c write (iout,*) 'facy',facy,
1657 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1658 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1660 uy(k,i)=facy*uy(k,i)
1662 C Compute the derivatives of uy
1665 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1666 & -dc_norm(k,i)*dc_norm(j,i-1)
1667 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1669 c uyder(j,j,1)=uyder(j,j,1)-costh
1670 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1671 uyder(j,j,1)=uyder(j,j,1)
1672 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1673 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1679 uygrad(l,k,j,i)=uyder(l,k,j)
1680 uzgrad(l,k,j,i)=uzder(l,k,j)
1684 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1685 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1686 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1687 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1690 C Compute the Z-axis
1691 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1692 costh=dcos(pi-theta(i+2))
1693 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1694 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1698 C Compute the derivatives of uz
1700 uzder(2,1,1)=-dc_norm(3,i+1)
1701 uzder(3,1,1)= dc_norm(2,i+1)
1702 uzder(1,2,1)= dc_norm(3,i+1)
1704 uzder(3,2,1)=-dc_norm(1,i+1)
1705 uzder(1,3,1)=-dc_norm(2,i+1)
1706 uzder(2,3,1)= dc_norm(1,i+1)
1709 uzder(2,1,2)= dc_norm(3,i)
1710 uzder(3,1,2)=-dc_norm(2,i)
1711 uzder(1,2,2)=-dc_norm(3,i)
1713 uzder(3,2,2)= dc_norm(1,i)
1714 uzder(1,3,2)= dc_norm(2,i)
1715 uzder(2,3,2)=-dc_norm(1,i)
1717 C Compute the Y-axis
1719 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1720 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1721 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1723 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1726 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1727 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1730 c write (iout,*) 'facy',facy,
1731 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1732 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1734 uy(k,i)=facy*uy(k,i)
1736 C Compute the derivatives of uy
1739 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1740 & -dc_norm(k,i)*dc_norm(j,i+1)
1741 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1743 c uyder(j,j,1)=uyder(j,j,1)-costh
1744 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1745 uyder(j,j,1)=uyder(j,j,1)
1746 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1747 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1753 uygrad(l,k,j,i)=uyder(l,k,j)
1754 uzgrad(l,k,j,i)=uzder(l,k,j)
1758 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1759 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1760 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1761 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1768 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1769 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1776 C-----------------------------------------------------------------------------
1777 subroutine check_vecgrad
1778 implicit real*8 (a-h,o-z)
1779 include 'DIMENSIONS'
1780 include 'DIMENSIONS.ZSCOPT'
1781 include 'COMMON.IOUNITS'
1782 include 'COMMON.GEO'
1783 include 'COMMON.VAR'
1784 include 'COMMON.LOCAL'
1785 include 'COMMON.CHAIN'
1786 include 'COMMON.VECTORS'
1787 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1788 dimension uyt(3,maxres),uzt(3,maxres)
1789 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1790 double precision delta /1.0d-7/
1793 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1794 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1795 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1796 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1797 cd & (dc_norm(if90,i),if90=1,3)
1798 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1799 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1800 cd write(iout,'(a)')
1806 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1807 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1820 cd write (iout,*) 'i=',i
1822 erij(k)=dc_norm(k,i)
1826 dc_norm(k,i)=erij(k)
1828 dc_norm(j,i)=dc_norm(j,i)+delta
1829 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1831 c dc_norm(k,i)=dc_norm(k,i)/fac
1833 c write (iout,*) (dc_norm(k,i),k=1,3)
1834 c write (iout,*) (erij(k),k=1,3)
1837 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1838 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1839 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1840 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1842 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1843 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1844 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1847 dc_norm(k,i)=erij(k)
1850 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1851 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1852 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1853 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1854 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1855 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1856 cd write (iout,'(a)')
1861 C--------------------------------------------------------------------------
1862 subroutine set_matrices
1863 implicit real*8 (a-h,o-z)
1864 include 'DIMENSIONS'
1865 include 'DIMENSIONS.ZSCOPT'
1866 include 'COMMON.IOUNITS'
1867 include 'COMMON.GEO'
1868 include 'COMMON.VAR'
1869 include 'COMMON.LOCAL'
1870 include 'COMMON.CHAIN'
1871 include 'COMMON.DERIV'
1872 include 'COMMON.INTERACT'
1873 include 'COMMON.CONTACTS'
1874 include 'COMMON.TORSION'
1875 include 'COMMON.VECTORS'
1876 include 'COMMON.FFIELD'
1877 double precision auxvec(2),auxmat(2,2)
1879 C Compute the virtual-bond-torsional-angle dependent quantities needed
1880 C to calculate the el-loc multibody terms of various order.
1883 if (i .lt. nres+1) then
1920 if (i .gt. 3 .and. i .lt. nres+1) then
1921 obrot_der(1,i-2)=-sin1
1922 obrot_der(2,i-2)= cos1
1923 Ugder(1,1,i-2)= sin1
1924 Ugder(1,2,i-2)=-cos1
1925 Ugder(2,1,i-2)=-cos1
1926 Ugder(2,2,i-2)=-sin1
1929 obrot2_der(1,i-2)=-dwasin2
1930 obrot2_der(2,i-2)= dwacos2
1931 Ug2der(1,1,i-2)= dwasin2
1932 Ug2der(1,2,i-2)=-dwacos2
1933 Ug2der(2,1,i-2)=-dwacos2
1934 Ug2der(2,2,i-2)=-dwasin2
1936 obrot_der(1,i-2)=0.0d0
1937 obrot_der(2,i-2)=0.0d0
1938 Ugder(1,1,i-2)=0.0d0
1939 Ugder(1,2,i-2)=0.0d0
1940 Ugder(2,1,i-2)=0.0d0
1941 Ugder(2,2,i-2)=0.0d0
1942 obrot2_der(1,i-2)=0.0d0
1943 obrot2_der(2,i-2)=0.0d0
1944 Ug2der(1,1,i-2)=0.0d0
1945 Ug2der(1,2,i-2)=0.0d0
1946 Ug2der(2,1,i-2)=0.0d0
1947 Ug2der(2,2,i-2)=0.0d0
1949 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1950 if (itype(i-2).le.ntyp) then
1951 iti = itortyp(itype(i-2))
1958 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1959 if (itype(i-1).le.ntyp) then
1960 iti1 = itortyp(itype(i-1))
1967 cd write (iout,*) '*******i',i,' iti1',iti
1968 cd write (iout,*) 'b1',b1(:,iti)
1969 cd write (iout,*) 'b2',b2(:,iti)
1970 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1971 c print *,"itilde1 i iti iti1",i,iti,iti1
1972 if (i .gt. iatel_s+2) then
1973 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1974 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1975 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1976 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1977 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1978 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1979 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1989 DtUg2(l,k,i-2)=0.0d0
1993 c print *,"itilde2 i iti iti1",i,iti,iti1
1994 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1995 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1996 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1997 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1998 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1999 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2000 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2001 c print *,"itilde3 i iti iti1",i,iti,iti1
2003 muder(k,i-2)=Ub2der(k,i-2)
2005 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2006 if (itype(i-1).le.ntyp) then
2007 iti1 = itortyp(itype(i-1))
2015 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2017 C write (iout,*) 'mumu',i,b1(1,iti),Ub2(1,i-2)
2019 C Vectors and matrices dependent on a single virtual-bond dihedral.
2020 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2021 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2022 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2023 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2024 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2025 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2026 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2027 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2028 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2029 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
2030 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
2032 C Matrices dependent on two consecutive virtual-bond dihedrals.
2033 C The order of matrices is from left to right.
2035 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2036 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2037 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2038 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2039 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2040 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2041 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2042 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2045 cd iti = itortyp(itype(i))
2048 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2049 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2054 C--------------------------------------------------------------------------
2055 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2057 C This subroutine calculates the average interaction energy and its gradient
2058 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2059 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2060 C The potential depends both on the distance of peptide-group centers and on
2061 C the orientation of the CA-CA virtual bonds.
2063 implicit real*8 (a-h,o-z)
2064 include 'DIMENSIONS'
2065 include 'DIMENSIONS.ZSCOPT'
2066 include 'COMMON.CONTROL'
2067 include 'COMMON.IOUNITS'
2068 include 'COMMON.GEO'
2069 include 'COMMON.VAR'
2070 include 'COMMON.LOCAL'
2071 include 'COMMON.CHAIN'
2072 include 'COMMON.DERIV'
2073 include 'COMMON.INTERACT'
2074 include 'COMMON.CONTACTS'
2075 include 'COMMON.TORSION'
2076 include 'COMMON.VECTORS'
2077 include 'COMMON.FFIELD'
2078 include 'COMMON.SHIELD'
2079 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2080 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2081 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2082 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2083 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2084 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2085 double precision scal_el /0.5d0/
2087 C 13-go grudnia roku pamietnego...
2088 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2089 & 0.0d0,1.0d0,0.0d0,
2090 & 0.0d0,0.0d0,1.0d0/
2091 cd write(iout,*) 'In EELEC'
2093 cd write(iout,*) 'Type',i
2094 cd write(iout,*) 'B1',B1(:,i)
2095 cd write(iout,*) 'B2',B2(:,i)
2096 cd write(iout,*) 'CC',CC(:,:,i)
2097 cd write(iout,*) 'DD',DD(:,:,i)
2098 cd write(iout,*) 'EE',EE(:,:,i)
2100 cd call check_vecgrad
2102 if (icheckgrad.eq.1) then
2104 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2106 dc_norm(k,i)=dc(k,i)*fac
2108 c write (iout,*) 'i',i,' fac',fac
2111 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2112 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2113 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2114 cd if (wel_loc.gt.0.0d0) then
2115 if (icheckgrad.eq.1) then
2116 call vec_and_deriv_test
2123 cd write (iout,*) 'i=',i
2125 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2128 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2129 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2142 C print '(a)','Enter EELEC'
2143 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2145 gel_loc_loc(i)=0.0d0
2148 do i=iatel_s,iatel_e
2150 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2151 C & .or. itype(i+2).eq.ntyp1) cycle
2153 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2154 C & .or. itype(i+2).eq.ntyp1
2155 C & .or. itype(i-1).eq.ntyp1
2158 if (itel(i).eq.0) goto 1215
2162 dx_normi=dc_norm(1,i)
2163 dy_normi=dc_norm(2,i)
2164 dz_normi=dc_norm(3,i)
2165 xmedi=c(1,i)+0.5d0*dxi
2166 ymedi=c(2,i)+0.5d0*dyi
2167 zmedi=c(3,i)+0.5d0*dzi
2168 xmedi=mod(xmedi,boxxsize)
2169 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2170 ymedi=mod(ymedi,boxysize)
2171 if (ymedi.lt.0) ymedi=ymedi+boxysize
2172 zmedi=mod(zmedi,boxzsize)
2173 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2175 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2176 do j=ielstart(i),ielend(i)
2178 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2179 C & .or.itype(j+2).eq.ntyp1
2182 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2183 C & .or.itype(j+2).eq.ntyp1
2184 C & .or.itype(j-1).eq.ntyp1
2189 if (itel(j).eq.0) goto 1216
2193 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2194 aaa=app(iteli,itelj)
2195 bbb=bpp(iteli,itelj)
2196 C Diagnostics only!!!
2202 ael6i=ael6(iteli,itelj)
2203 ael3i=ael3(iteli,itelj)
2207 dx_normj=dc_norm(1,j)
2208 dy_normj=dc_norm(2,j)
2209 dz_normj=dc_norm(3,j)
2214 if (xj.lt.0) xj=xj+boxxsize
2216 if (yj.lt.0) yj=yj+boxysize
2218 if (zj.lt.0) zj=zj+boxzsize
2219 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2227 xj=xj_safe+xshift*boxxsize
2228 yj=yj_safe+yshift*boxysize
2229 zj=zj_safe+zshift*boxzsize
2230 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2231 if(dist_temp.lt.dist_init) then
2241 if (isubchap.eq.1) then
2250 rij=xj*xj+yj*yj+zj*zj
2251 sss=sscale(sqrt(rij))
2252 sssgrad=sscagrad(sqrt(rij))
2258 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2259 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2260 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2261 fac=cosa-3.0D0*cosb*cosg
2263 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2264 if (j.eq.i+2) ev1=scal_el*ev1
2269 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2272 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2273 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2274 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2275 if (shield_mode.gt.0) then
2278 write(iout,*) "ees_compon",i,j,el1,el2,
2279 & fac_shield(i),fac_shield(j)
2284 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2285 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2294 evdw1=evdw1+evdwij*sss
2295 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2296 c &'evdw1',i,j,evdwij
2297 c &,iteli,itelj,aaa,evdw1
2299 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2300 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2301 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2302 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2303 c & xmedi,ymedi,zmedi,xj,yj,zj
2305 C Calculate contributions to the Cartesian gradient.
2308 facvdw=-6*rrmij*(ev1+evdwij)*sss
2309 facel=-3*rrmij*(el1+eesij)
2316 * Radial derivatives. First process both termini of the fragment (i,j)
2321 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2322 & (shield_mode.gt.0)) then
2324 do ilist=1,ishield_list(i)
2325 iresshield=shield_list(ilist,i)
2327 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2329 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2331 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2332 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2333 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2334 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2335 C if (iresshield.gt.i) then
2336 C do ishi=i+1,iresshield-1
2337 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2338 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2342 C do ishi=iresshield,i
2343 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2344 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2350 do ilist=1,ishield_list(j)
2351 iresshield=shield_list(ilist,j)
2353 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2355 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2357 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2358 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2363 gshieldc(k,i)=gshieldc(k,i)+
2364 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2365 gshieldc(k,j)=gshieldc(k,j)+
2366 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2367 gshieldc(k,i-1)=gshieldc(k,i-1)+
2368 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2369 gshieldc(k,j-1)=gshieldc(k,j-1)+
2370 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2377 gelc(k,i)=gelc(k,i)+ghalf
2378 gelc(k,j)=gelc(k,j)+ghalf
2381 * Loop over residues i+1 thru j-1.
2385 gelc(l,k)=gelc(l,k)+ggg(l)
2391 if (sss.gt.0.0) then
2392 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2393 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2394 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2402 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2403 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2406 * Loop over residues i+1 thru j-1.
2410 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2414 facvdw=(ev1+evdwij)*sss
2417 fac=-3*rrmij*(facvdw+facvdw+facel)
2423 * Radial derivatives. First process both termini of the fragment (i,j)
2430 gelc(k,i)=gelc(k,i)+ghalf
2431 gelc(k,j)=gelc(k,j)+ghalf
2434 * Loop over residues i+1 thru j-1.
2438 gelc(l,k)=gelc(l,k)+ggg(l)
2445 ecosa=2.0D0*fac3*fac1+fac4
2448 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2449 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2451 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2452 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2454 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2455 cd & (dcosg(k),k=1,3)
2457 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2458 & *fac_shield(i)**2*fac_shield(j)**2
2462 gelc(k,i)=gelc(k,i)+ghalf
2463 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2464 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2465 & *fac_shield(i)**2*fac_shield(j)**2
2467 gelc(k,j)=gelc(k,j)+ghalf
2468 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2469 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2470 & *fac_shield(i)**2*fac_shield(j)**2
2474 gelc(l,k)=gelc(l,k)+ggg(l)
2479 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2480 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2481 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2483 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2484 C energy of a peptide unit is assumed in the form of a second-order
2485 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2486 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2487 C are computed for EVERY pair of non-contiguous peptide groups.
2489 if (j.lt.nres-1) then
2500 muij(kkk)=mu(k,i)*mu(l,j)
2503 cd write (iout,*) 'EELEC: i',i,' j',j
2504 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2505 cd write(iout,*) 'muij',muij
2506 ury=scalar(uy(1,i),erij)
2507 urz=scalar(uz(1,i),erij)
2508 vry=scalar(uy(1,j),erij)
2509 vrz=scalar(uz(1,j),erij)
2510 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2511 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2512 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2513 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2514 C For diagnostics only
2519 fac=dsqrt(-ael6i)*r3ij
2520 cd write (2,*) 'fac=',fac
2521 C For diagnostics only
2527 cd write (iout,'(4i5,4f10.5)')
2528 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2529 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2530 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2531 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2532 cd write (iout,'(4f10.5)')
2533 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2534 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2535 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2536 cd write (iout,'(2i3,9f10.5/)') i,j,
2537 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2539 C Derivatives of the elements of A in virtual-bond vectors
2540 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2547 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2548 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2549 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2550 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2551 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2552 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2553 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2554 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2555 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2556 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2557 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2558 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2568 C Compute radial contributions to the gradient
2590 C Add the contributions coming from er
2593 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2594 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2595 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2596 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2599 C Derivatives in DC(i)
2600 ghalf1=0.5d0*agg(k,1)
2601 ghalf2=0.5d0*agg(k,2)
2602 ghalf3=0.5d0*agg(k,3)
2603 ghalf4=0.5d0*agg(k,4)
2604 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2605 & -3.0d0*uryg(k,2)*vry)+ghalf1
2606 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2607 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2608 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2609 & -3.0d0*urzg(k,2)*vry)+ghalf3
2610 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2611 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2612 C Derivatives in DC(i+1)
2613 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2614 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2615 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2616 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2617 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2618 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2619 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2620 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2621 C Derivatives in DC(j)
2622 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2623 & -3.0d0*vryg(k,2)*ury)+ghalf1
2624 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2625 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2626 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2627 & -3.0d0*vryg(k,2)*urz)+ghalf3
2628 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2629 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2630 C Derivatives in DC(j+1) or DC(nres-1)
2631 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2632 & -3.0d0*vryg(k,3)*ury)
2633 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2634 & -3.0d0*vrzg(k,3)*ury)
2635 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2636 & -3.0d0*vryg(k,3)*urz)
2637 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2638 & -3.0d0*vrzg(k,3)*urz)
2643 C Derivatives in DC(i+1)
2644 cd aggi1(k,1)=agg(k,1)
2645 cd aggi1(k,2)=agg(k,2)
2646 cd aggi1(k,3)=agg(k,3)
2647 cd aggi1(k,4)=agg(k,4)
2648 C Derivatives in DC(j)
2653 C Derivatives in DC(j+1)
2658 if (j.eq.nres-1 .and. i.lt.j-2) then
2660 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2661 cd aggj1(k,l)=agg(k,l)
2667 C Check the loc-el terms by numerical integration
2677 aggi(k,l)=-aggi(k,l)
2678 aggi1(k,l)=-aggi1(k,l)
2679 aggj(k,l)=-aggj(k,l)
2680 aggj1(k,l)=-aggj1(k,l)
2683 if (j.lt.nres-1) then
2689 aggi(k,l)=-aggi(k,l)
2690 aggi1(k,l)=-aggi1(k,l)
2691 aggj(k,l)=-aggj(k,l)
2692 aggj1(k,l)=-aggj1(k,l)
2703 aggi(k,l)=-aggi(k,l)
2704 aggi1(k,l)=-aggi1(k,l)
2705 aggj(k,l)=-aggj(k,l)
2706 aggj1(k,l)=-aggj1(k,l)
2712 IF (wel_loc.gt.0.0d0) THEN
2713 C Contribution to the local-electrostatic energy coming from the i-j pair
2714 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2716 if (shield_mode.eq.0) then
2723 eel_loc_ij=eel_loc_ij
2724 & *fac_shield(i)*fac_shield(j)
2725 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2726 C write (iout,'(a6,2i5,0pf7.3)')
2727 C & 'eelloc',i,j,eel_loc_ij
2728 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2729 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2730 C eel_loc=eel_loc+eel_loc_ij
2731 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2732 & (shield_mode.gt.0)) then
2735 do ilist=1,ishield_list(i)
2736 iresshield=shield_list(ilist,i)
2738 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2741 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2743 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2744 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2748 do ilist=1,ishield_list(j)
2749 iresshield=shield_list(ilist,j)
2751 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2754 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2756 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2757 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2763 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2764 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2765 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2766 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2767 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2768 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2769 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2770 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2773 eel_loc=eel_loc+eel_loc_ij
2775 C Partial derivatives in virtual-bond dihedral angles gamma
2778 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2779 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2780 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
2781 & *fac_shield(i)*fac_shield(j)
2783 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2784 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2785 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
2786 & *fac_shield(i)*fac_shield(j)
2788 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2789 cd write(iout,*) 'agg ',agg
2790 cd write(iout,*) 'aggi ',aggi
2791 cd write(iout,*) 'aggi1',aggi1
2792 cd write(iout,*) 'aggj ',aggj
2793 cd write(iout,*) 'aggj1',aggj1
2795 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2797 ggg(l)=(agg(l,1)*muij(1)+
2798 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
2799 & *fac_shield(i)*fac_shield(j)
2804 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2807 C Remaining derivatives of eello
2809 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
2810 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
2811 & *fac_shield(i)*fac_shield(j)
2813 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
2814 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
2815 & *fac_shield(i)*fac_shield(j)
2817 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
2818 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
2819 & *fac_shield(i)*fac_shield(j)
2821 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
2822 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
2823 & *fac_shield(i)*fac_shield(j)
2828 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2829 C Contributions from turns
2834 call eturn34(i,j,eello_turn3,eello_turn4)
2836 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2837 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2839 C Calculate the contact function. The ith column of the array JCONT will
2840 C contain the numbers of atoms that make contacts with the atom I (of numbers
2841 C greater than I). The arrays FACONT and GACONT will contain the values of
2842 C the contact function and its derivative.
2843 c r0ij=1.02D0*rpp(iteli,itelj)
2844 c r0ij=1.11D0*rpp(iteli,itelj)
2845 r0ij=2.20D0*rpp(iteli,itelj)
2846 c r0ij=1.55D0*rpp(iteli,itelj)
2847 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2848 if (fcont.gt.0.0D0) then
2849 num_conti=num_conti+1
2850 if (num_conti.gt.maxconts) then
2851 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2852 & ' will skip next contacts for this conf.'
2854 jcont_hb(num_conti,i)=j
2855 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2856 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2857 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2859 d_cont(num_conti,i)=rij
2860 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2861 C --- Electrostatic-interaction matrix ---
2862 a_chuj(1,1,num_conti,i)=a22
2863 a_chuj(1,2,num_conti,i)=a23
2864 a_chuj(2,1,num_conti,i)=a32
2865 a_chuj(2,2,num_conti,i)=a33
2866 C --- Gradient of rij
2868 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2871 c a_chuj(1,1,num_conti,i)=-0.61d0
2872 c a_chuj(1,2,num_conti,i)= 0.4d0
2873 c a_chuj(2,1,num_conti,i)= 0.65d0
2874 c a_chuj(2,2,num_conti,i)= 0.50d0
2875 c else if (i.eq.2) then
2876 c a_chuj(1,1,num_conti,i)= 0.0d0
2877 c a_chuj(1,2,num_conti,i)= 0.0d0
2878 c a_chuj(2,1,num_conti,i)= 0.0d0
2879 c a_chuj(2,2,num_conti,i)= 0.0d0
2881 C --- and its gradients
2882 cd write (iout,*) 'i',i,' j',j
2884 cd write (iout,*) 'iii 1 kkk',kkk
2885 cd write (iout,*) agg(kkk,:)
2888 cd write (iout,*) 'iii 2 kkk',kkk
2889 cd write (iout,*) aggi(kkk,:)
2892 cd write (iout,*) 'iii 3 kkk',kkk
2893 cd write (iout,*) aggi1(kkk,:)
2896 cd write (iout,*) 'iii 4 kkk',kkk
2897 cd write (iout,*) aggj(kkk,:)
2900 cd write (iout,*) 'iii 5 kkk',kkk
2901 cd write (iout,*) aggj1(kkk,:)
2908 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2909 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2910 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2911 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2912 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2914 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2920 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2921 C Calculate contact energies
2923 wij=cosa-3.0D0*cosb*cosg
2926 c fac3=dsqrt(-ael6i)/r0ij**3
2927 fac3=dsqrt(-ael6i)*r3ij
2928 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2929 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2931 if (shield_mode.eq.0) then
2935 ees0plist(num_conti,i)=j
2936 C fac_shield(i)=0.4d0
2937 C fac_shield(j)=0.6d0
2939 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2940 & *fac_shield(i)*fac_shield(j)
2942 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2943 & *fac_shield(i)*fac_shield(j)
2945 C Diagnostics. Comment out or remove after debugging!
2946 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2947 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2948 c ees0m(num_conti,i)=0.0D0
2950 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2951 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2952 facont_hb(num_conti,i)=fcont
2954 C Angular derivatives of the contact function
2955 ees0pij1=fac3/ees0pij
2956 ees0mij1=fac3/ees0mij
2957 fac3p=-3.0D0*fac3*rrmij
2958 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2959 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2961 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2962 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2963 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2964 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2965 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2966 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2967 ecosap=ecosa1+ecosa2
2968 ecosbp=ecosb1+ecosb2
2969 ecosgp=ecosg1+ecosg2
2970 ecosam=ecosa1-ecosa2
2971 ecosbm=ecosb1-ecosb2
2972 ecosgm=ecosg1-ecosg2
2981 fprimcont=fprimcont/rij
2982 cd facont_hb(num_conti,i)=1.0D0
2983 C Following line is for diagnostics.
2986 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2987 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2990 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2991 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2993 gggp(1)=gggp(1)+ees0pijp*xj
2994 gggp(2)=gggp(2)+ees0pijp*yj
2995 gggp(3)=gggp(3)+ees0pijp*zj
2996 gggm(1)=gggm(1)+ees0mijp*xj
2997 gggm(2)=gggm(2)+ees0mijp*yj
2998 gggm(3)=gggm(3)+ees0mijp*zj
2999 C Derivatives due to the contact function
3000 gacont_hbr(1,num_conti,i)=fprimcont*xj
3001 gacont_hbr(2,num_conti,i)=fprimcont*yj
3002 gacont_hbr(3,num_conti,i)=fprimcont*zj
3004 ghalfp=0.5D0*gggp(k)
3005 ghalfm=0.5D0*gggm(k)
3006 gacontp_hb1(k,num_conti,i)=ghalfp
3007 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3008 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3009 & *fac_shield(i)*fac_shield(j)
3011 gacontp_hb2(k,num_conti,i)=ghalfp
3012 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3013 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3014 & *fac_shield(i)*fac_shield(j)
3016 gacontp_hb3(k,num_conti,i)=gggp(k)
3017 & *fac_shield(i)*fac_shield(j)
3019 gacontm_hb1(k,num_conti,i)=ghalfm
3020 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3021 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3022 & *fac_shield(i)*fac_shield(j)
3024 gacontm_hb2(k,num_conti,i)=ghalfm
3025 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3026 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3027 & *fac_shield(i)*fac_shield(j)
3029 gacontm_hb3(k,num_conti,i)=gggm(k)
3030 & *fac_shield(i)*fac_shield(j)
3034 C Diagnostics. Comment out or remove after debugging!
3036 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3037 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3038 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3039 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3040 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3041 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3044 endif ! num_conti.le.maxconts
3049 num_cont_hb(i)=num_conti
3053 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3054 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3056 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3057 ccc eel_loc=eel_loc+eello_turn3
3060 C-----------------------------------------------------------------------------
3061 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3062 C Third- and fourth-order contributions from turns
3063 implicit real*8 (a-h,o-z)
3064 include 'DIMENSIONS'
3065 include 'DIMENSIONS.ZSCOPT'
3066 include 'COMMON.IOUNITS'
3067 include 'COMMON.GEO'
3068 include 'COMMON.VAR'
3069 include 'COMMON.LOCAL'
3070 include 'COMMON.CHAIN'
3071 include 'COMMON.DERIV'
3072 include 'COMMON.INTERACT'
3073 include 'COMMON.CONTACTS'
3074 include 'COMMON.TORSION'
3075 include 'COMMON.VECTORS'
3076 include 'COMMON.FFIELD'
3077 include 'COMMON.SHIELD'
3078 include 'COMMON.CONTROL'
3080 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3081 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3082 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3083 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3084 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3085 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3087 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3088 C changes suggested by Ana to avoid out of bounds
3089 C & .or.((i+5).gt.nres)
3090 C & .or.((i-1).le.0)
3091 C end of changes suggested by Ana
3092 & .or. itype(i+2).eq.ntyp1
3093 & .or. itype(i+3).eq.ntyp1
3094 C & .or. itype(i+5).eq.ntyp1
3095 C & .or. itype(i).eq.ntyp1
3096 C & .or. itype(i-1).eq.ntyp1
3099 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3101 C Third-order contributions
3108 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3109 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3110 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3111 call transpose2(auxmat(1,1),auxmat1(1,1))
3112 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3113 if (shield_mode.eq.0) then
3121 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3122 & *fac_shield(i)*fac_shield(j)
3123 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3124 & *fac_shield(i)*fac_shield(j)
3126 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3127 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3128 cd & ' eello_turn3_num',4*eello_turn3_num
3130 C Derivatives in shield mode
3131 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3132 & (shield_mode.gt.0)) then
3135 do ilist=1,ishield_list(i)
3136 iresshield=shield_list(ilist,i)
3138 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3140 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3142 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3143 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3147 do ilist=1,ishield_list(j)
3148 iresshield=shield_list(ilist,j)
3150 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3152 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3154 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3155 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3162 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3163 & grad_shield(k,i)*eello_t3/fac_shield(i)
3164 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3165 & grad_shield(k,j)*eello_t3/fac_shield(j)
3166 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3167 & grad_shield(k,i)*eello_t3/fac_shield(i)
3168 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3169 & grad_shield(k,j)*eello_t3/fac_shield(j)
3173 C Derivatives in gamma(i)
3174 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3175 call transpose2(auxmat2(1,1),pizda(1,1))
3176 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3177 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3178 & *fac_shield(i)*fac_shield(j)
3179 C Derivatives in gamma(i+1)
3180 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3181 call transpose2(auxmat2(1,1),pizda(1,1))
3182 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3183 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3184 & +0.5d0*(pizda(1,1)+pizda(2,2))
3185 & *fac_shield(i)*fac_shield(j)
3187 C Cartesian derivatives
3189 a_temp(1,1)=aggi(l,1)
3190 a_temp(1,2)=aggi(l,2)
3191 a_temp(2,1)=aggi(l,3)
3192 a_temp(2,2)=aggi(l,4)
3193 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3194 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3195 & +0.5d0*(pizda(1,1)+pizda(2,2))
3196 & *fac_shield(i)*fac_shield(j)
3198 a_temp(1,1)=aggi1(l,1)
3199 a_temp(1,2)=aggi1(l,2)
3200 a_temp(2,1)=aggi1(l,3)
3201 a_temp(2,2)=aggi1(l,4)
3202 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3203 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3204 & +0.5d0*(pizda(1,1)+pizda(2,2))
3205 & *fac_shield(i)*fac_shield(j)
3207 a_temp(1,1)=aggj(l,1)
3208 a_temp(1,2)=aggj(l,2)
3209 a_temp(2,1)=aggj(l,3)
3210 a_temp(2,2)=aggj(l,4)
3211 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3212 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3213 & +0.5d0*(pizda(1,1)+pizda(2,2))
3214 & *fac_shield(i)*fac_shield(j)
3216 a_temp(1,1)=aggj1(l,1)
3217 a_temp(1,2)=aggj1(l,2)
3218 a_temp(2,1)=aggj1(l,3)
3219 a_temp(2,2)=aggj1(l,4)
3220 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3221 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3222 & +0.5d0*(pizda(1,1)+pizda(2,2))
3223 & *fac_shield(i)*fac_shield(j)
3228 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3229 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3230 C changes suggested by Ana to avoid out of bounds
3231 C & .or.((i+5).gt.nres)
3232 C & .or.((i-1).le.0)
3233 C end of changes suggested by Ana
3234 & .or. itype(i+3).eq.ntyp1
3235 & .or. itype(i+4).eq.ntyp1
3236 C & .or. itype(i+5).eq.ntyp1
3237 & .or. itype(i).eq.ntyp1
3238 C & .or. itype(i-1).eq.ntyp1
3240 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3242 C Fourth-order contributions
3250 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3251 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3252 iti1=itortyp(itype(i+1))
3253 iti2=itortyp(itype(i+2))
3254 iti3=itortyp(itype(i+3))
3255 call transpose2(EUg(1,1,i+1),e1t(1,1))
3256 call transpose2(Eug(1,1,i+2),e2t(1,1))
3257 call transpose2(Eug(1,1,i+3),e3t(1,1))
3258 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3259 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3260 s1=scalar2(b1(1,iti2),auxvec(1))
3261 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3262 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3263 s2=scalar2(b1(1,iti1),auxvec(1))
3264 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3265 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3266 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3267 if (shield_mode.eq.0) then
3275 eello_turn4=eello_turn4-(s1+s2+s3)
3276 & *fac_shield(i)*fac_shield(j)
3277 eello_t4=-(s1+s2+s3)
3278 & *fac_shield(i)*fac_shield(j)
3280 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3281 cd & ' eello_turn4_num',8*eello_turn4_num
3282 C Derivatives in gamma(i)
3284 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3285 & (shield_mode.gt.0)) then
3288 do ilist=1,ishield_list(i)
3289 iresshield=shield_list(ilist,i)
3291 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3293 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3295 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3296 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3300 do ilist=1,ishield_list(j)
3301 iresshield=shield_list(ilist,j)
3303 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3305 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3307 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3308 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3315 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3316 & grad_shield(k,i)*eello_t4/fac_shield(i)
3317 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3318 & grad_shield(k,j)*eello_t4/fac_shield(j)
3319 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3320 & grad_shield(k,i)*eello_t4/fac_shield(i)
3321 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3322 & grad_shield(k,j)*eello_t4/fac_shield(j)
3325 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3326 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3327 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3328 s1=scalar2(b1(1,iti2),auxvec(1))
3329 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3330 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3331 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3332 & *fac_shield(i)*fac_shield(j)
3334 C Derivatives in gamma(i+1)
3335 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3336 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3337 s2=scalar2(b1(1,iti1),auxvec(1))
3338 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3339 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3340 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3341 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3342 & *fac_shield(i)*fac_shield(j)
3344 C Derivatives in gamma(i+2)
3345 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3346 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3347 s1=scalar2(b1(1,iti2),auxvec(1))
3348 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3349 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3350 s2=scalar2(b1(1,iti1),auxvec(1))
3351 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3352 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3353 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3354 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3355 & *fac_shield(i)*fac_shield(j)
3357 C Cartesian derivatives
3359 C Derivatives of this turn contributions in DC(i+2)
3360 if (j.lt.nres-1) then
3362 a_temp(1,1)=agg(l,1)
3363 a_temp(1,2)=agg(l,2)
3364 a_temp(2,1)=agg(l,3)
3365 a_temp(2,2)=agg(l,4)
3366 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3367 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3368 s1=scalar2(b1(1,iti2),auxvec(1))
3369 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3370 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3371 s2=scalar2(b1(1,iti1),auxvec(1))
3372 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3373 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3374 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3376 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3377 & *fac_shield(i)*fac_shield(j)
3381 C Remaining derivatives of this turn contribution
3383 a_temp(1,1)=aggi(l,1)
3384 a_temp(1,2)=aggi(l,2)
3385 a_temp(2,1)=aggi(l,3)
3386 a_temp(2,2)=aggi(l,4)
3387 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3388 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3389 s1=scalar2(b1(1,iti2),auxvec(1))
3390 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3391 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3392 s2=scalar2(b1(1,iti1),auxvec(1))
3393 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3394 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3395 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3396 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3397 & *fac_shield(i)*fac_shield(j)
3399 a_temp(1,1)=aggi1(l,1)
3400 a_temp(1,2)=aggi1(l,2)
3401 a_temp(2,1)=aggi1(l,3)
3402 a_temp(2,2)=aggi1(l,4)
3403 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3404 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3405 s1=scalar2(b1(1,iti2),auxvec(1))
3406 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3407 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3408 s2=scalar2(b1(1,iti1),auxvec(1))
3409 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3410 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3411 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3412 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3413 & *fac_shield(i)*fac_shield(j)
3415 a_temp(1,1)=aggj(l,1)
3416 a_temp(1,2)=aggj(l,2)
3417 a_temp(2,1)=aggj(l,3)
3418 a_temp(2,2)=aggj(l,4)
3419 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3420 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3421 s1=scalar2(b1(1,iti2),auxvec(1))
3422 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3423 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3424 s2=scalar2(b1(1,iti1),auxvec(1))
3425 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3426 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3427 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3428 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3429 & *fac_shield(i)*fac_shield(j)
3431 a_temp(1,1)=aggj1(l,1)
3432 a_temp(1,2)=aggj1(l,2)
3433 a_temp(2,1)=aggj1(l,3)
3434 a_temp(2,2)=aggj1(l,4)
3435 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3436 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3437 s1=scalar2(b1(1,iti2),auxvec(1))
3438 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3439 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3440 s2=scalar2(b1(1,iti1),auxvec(1))
3441 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3442 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3443 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3444 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3445 & *fac_shield(i)*fac_shield(j)
3453 C-----------------------------------------------------------------------------
3454 subroutine vecpr(u,v,w)
3455 implicit real*8(a-h,o-z)
3456 dimension u(3),v(3),w(3)
3457 w(1)=u(2)*v(3)-u(3)*v(2)
3458 w(2)=-u(1)*v(3)+u(3)*v(1)
3459 w(3)=u(1)*v(2)-u(2)*v(1)
3462 C-----------------------------------------------------------------------------
3463 subroutine unormderiv(u,ugrad,unorm,ungrad)
3464 C This subroutine computes the derivatives of a normalized vector u, given
3465 C the derivatives computed without normalization conditions, ugrad. Returns
3468 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3469 double precision vec(3)
3470 double precision scalar
3472 c write (2,*) 'ugrad',ugrad
3475 vec(i)=scalar(ugrad(1,i),u(1))
3477 c write (2,*) 'vec',vec
3480 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3483 c write (2,*) 'ungrad',ungrad
3486 C-----------------------------------------------------------------------------
3487 subroutine escp(evdw2,evdw2_14)
3489 C This subroutine calculates the excluded-volume interaction energy between
3490 C peptide-group centers and side chains and its gradient in virtual-bond and
3491 C side-chain vectors.
3493 implicit real*8 (a-h,o-z)
3494 include 'DIMENSIONS'
3495 include 'DIMENSIONS.ZSCOPT'
3496 include 'COMMON.GEO'
3497 include 'COMMON.VAR'
3498 include 'COMMON.LOCAL'
3499 include 'COMMON.CHAIN'
3500 include 'COMMON.DERIV'
3501 include 'COMMON.INTERACT'
3502 include 'COMMON.FFIELD'
3503 include 'COMMON.IOUNITS'
3507 cd print '(a)','Enter ESCP'
3508 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3509 c & ' scal14',scal14
3510 do i=iatscp_s,iatscp_e
3511 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3513 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3514 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3515 if (iteli.eq.0) goto 1225
3516 xi=0.5D0*(c(1,i)+c(1,i+1))
3517 yi=0.5D0*(c(2,i)+c(2,i+1))
3518 zi=0.5D0*(c(3,i)+c(3,i+1))
3519 C Returning the ith atom to box
3521 if (xi.lt.0) xi=xi+boxxsize
3523 if (yi.lt.0) yi=yi+boxysize
3525 if (zi.lt.0) zi=zi+boxzsize
3526 do iint=1,nscp_gr(i)
3528 do j=iscpstart(i,iint),iscpend(i,iint)
3529 itypj=iabs(itype(j))
3530 if (itypj.eq.ntyp1) cycle
3531 C Uncomment following three lines for SC-p interactions
3535 C Uncomment following three lines for Ca-p interactions
3539 C returning the jth atom to box
3541 if (xj.lt.0) xj=xj+boxxsize
3543 if (yj.lt.0) yj=yj+boxysize
3545 if (zj.lt.0) zj=zj+boxzsize
3546 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3551 C Finding the closest jth atom
3555 xj=xj_safe+xshift*boxxsize
3556 yj=yj_safe+yshift*boxysize
3557 zj=zj_safe+zshift*boxzsize
3558 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3559 if(dist_temp.lt.dist_init) then
3569 if (subchap.eq.1) then
3578 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3579 C sss is scaling function for smoothing the cutoff gradient otherwise
3580 C the gradient would not be continuouse
3581 sss=sscale(1.0d0/(dsqrt(rrij)))
3582 if (sss.le.0.0d0) cycle
3583 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3585 e1=fac*fac*aad(itypj,iteli)
3586 e2=fac*bad(itypj,iteli)
3587 if (iabs(j-i) .le. 2) then
3590 evdw2_14=evdw2_14+(e1+e2)*sss
3593 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3594 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3595 c & bad(itypj,iteli)
3596 evdw2=evdw2+evdwij*sss
3599 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3601 fac=-(evdwij+e1)*rrij*sss
3602 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3607 cd write (iout,*) 'j<i'
3608 C Uncomment following three lines for SC-p interactions
3610 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3613 cd write (iout,*) 'j>i'
3616 C Uncomment following line for SC-p interactions
3617 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3621 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3625 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3626 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3629 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3639 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3640 gradx_scp(j,i)=expon*gradx_scp(j,i)
3643 C******************************************************************************
3647 C To save time the factor EXPON has been extracted from ALL components
3648 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3651 C******************************************************************************
3654 C--------------------------------------------------------------------------
3655 subroutine edis(ehpb)
3657 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3659 implicit real*8 (a-h,o-z)
3660 include 'DIMENSIONS'
3661 include 'DIMENSIONS.ZSCOPT'
3662 include 'COMMON.SBRIDGE'
3663 include 'COMMON.CHAIN'
3664 include 'COMMON.DERIV'
3665 include 'COMMON.VAR'
3666 include 'COMMON.INTERACT'
3667 include 'COMMON.CONTROL'
3668 include 'COMMON.IOUNITS'
3671 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3672 cd print *,'link_start=',link_start,' link_end=',link_end
3673 C write(iout,*) link_end, "link_end"
3674 if (link_end.eq.0) return
3675 do i=link_start,link_end
3676 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3677 C CA-CA distance used in regularization of structure.
3680 C iii and jjj point to the residues for which the distance is assigned.
3681 if (ii.gt.nres) then
3688 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3689 C distance and angle dependent SS bond potential.
3690 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3691 C & iabs(itype(jjj)).eq.1) then
3692 C write(iout,*) constr_dist,"const"
3693 if (.not.dyn_ss .and. i.le.nss) then
3694 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3695 & iabs(itype(jjj)).eq.1) then
3696 call ssbond_ene(iii,jjj,eij)
3699 else if (ii.gt.nres .and. jj.gt.nres) then
3700 c Restraints from contact prediction
3702 if (constr_dist.eq.11) then
3703 C ehpb=ehpb+fordepth(i)**4.0d0
3704 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3705 ehpb=ehpb+fordepth(i)**4.0d0
3706 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3707 fac=fordepth(i)**4.0d0
3708 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3709 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3710 C & ehpb,fordepth(i),dd
3711 C write(iout,*) ehpb,"atu?"
3713 C fac=fordepth(i)**4.0d0
3714 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3716 if (dhpb1(i).gt.0.0d0) then
3717 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3718 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3719 c write (iout,*) "beta nmr",
3720 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3724 C Get the force constant corresponding to this distance.
3726 C Calculate the contribution to energy.
3727 ehpb=ehpb+waga*rdis*rdis
3728 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3730 C Evaluate gradient.
3733 endif !end dhpb1(i).gt.0
3734 endif !end const_dist=11
3736 ggg(j)=fac*(c(j,jj)-c(j,ii))
3739 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3740 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3743 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3744 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3747 C write(iout,*) "before"
3749 C write(iout,*) "after",dd
3750 if (constr_dist.eq.11) then
3751 ehpb=ehpb+fordepth(i)**4.0d0
3752 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3753 fac=fordepth(i)**4.0d0
3754 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3755 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3756 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3757 C print *,ehpb,"tu?"
3758 C write(iout,*) ehpb,"btu?",
3759 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3760 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3761 C & ehpb,fordepth(i),dd
3763 if (dhpb1(i).gt.0.0d0) then
3764 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3765 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3766 c write (iout,*) "alph nmr",
3767 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3770 C Get the force constant corresponding to this distance.
3772 C Calculate the contribution to energy.
3773 ehpb=ehpb+waga*rdis*rdis
3774 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3776 C Evaluate gradient.
3783 ggg(j)=fac*(c(j,jj)-c(j,ii))
3785 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3786 C If this is a SC-SC distance, we need to calculate the contributions to the
3787 C Cartesian gradient in the SC vectors (ghpbx).
3790 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3791 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3796 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3801 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3804 C--------------------------------------------------------------------------
3805 subroutine ssbond_ene(i,j,eij)
3807 C Calculate the distance and angle dependent SS-bond potential energy
3808 C using a free-energy function derived based on RHF/6-31G** ab initio
3809 C calculations of diethyl disulfide.
3811 C A. Liwo and U. Kozlowska, 11/24/03
3813 implicit real*8 (a-h,o-z)
3814 include 'DIMENSIONS'
3815 include 'DIMENSIONS.ZSCOPT'
3816 include 'COMMON.SBRIDGE'
3817 include 'COMMON.CHAIN'
3818 include 'COMMON.DERIV'
3819 include 'COMMON.LOCAL'
3820 include 'COMMON.INTERACT'
3821 include 'COMMON.VAR'
3822 include 'COMMON.IOUNITS'
3823 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3824 itypi=iabs(itype(i))
3828 dxi=dc_norm(1,nres+i)
3829 dyi=dc_norm(2,nres+i)
3830 dzi=dc_norm(3,nres+i)
3831 dsci_inv=dsc_inv(itypi)
3832 itypj=iabs(itype(j))
3833 dscj_inv=dsc_inv(itypj)
3837 dxj=dc_norm(1,nres+j)
3838 dyj=dc_norm(2,nres+j)
3839 dzj=dc_norm(3,nres+j)
3840 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3845 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3846 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3847 om12=dxi*dxj+dyi*dyj+dzi*dzj
3849 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3850 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3856 deltat12=om2-om1+2.0d0
3858 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3859 & +akct*deltad*deltat12
3860 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3861 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3862 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3863 c & " deltat12",deltat12," eij",eij
3864 ed=2*akcm*deltad+akct*deltat12
3866 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3867 eom1=-2*akth*deltat1-pom1-om2*pom2
3868 eom2= 2*akth*deltat2+pom1-om1*pom2
3871 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3874 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3875 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3876 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3877 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3880 C Calculate the components of the gradient in DC and X
3884 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3889 C--------------------------------------------------------------------------
3890 subroutine ebond(estr)
3892 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3894 implicit real*8 (a-h,o-z)
3895 include 'DIMENSIONS'
3896 include 'DIMENSIONS.ZSCOPT'
3897 include 'COMMON.LOCAL'
3898 include 'COMMON.GEO'
3899 include 'COMMON.INTERACT'
3900 include 'COMMON.DERIV'
3901 include 'COMMON.VAR'
3902 include 'COMMON.CHAIN'
3903 include 'COMMON.IOUNITS'
3904 include 'COMMON.NAMES'
3905 include 'COMMON.FFIELD'
3906 include 'COMMON.CONTROL'
3907 logical energy_dec /.false./
3908 double precision u(3),ud(3)
3911 c write (iout,*) "distchainmax",distchainmax
3913 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3914 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3916 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3917 C & *dc(j,i-1)/vbld(i)
3919 C if (energy_dec) write(iout,*)
3920 C & "estr1",i,vbld(i),distchainmax,
3921 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3923 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3924 diff = vbld(i)-vbldpDUM
3925 C write(iout,*) i,diff
3927 diff = vbld(i)-vbldp0
3928 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3932 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3935 C write (iout,'(a7,i5,4f7.3)')
3936 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
3938 estr=0.5d0*AKP*estr+estr1
3940 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3944 if (iti.ne.10 .and. iti.ne.ntyp1) then
3947 diff=vbld(i+nres)-vbldsc0(1,iti)
3948 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3949 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
3950 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3952 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3956 diff=vbld(i+nres)-vbldsc0(j,iti)
3957 ud(j)=aksc(j,iti)*diff
3958 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3972 uprod2=uprod2*u(k)*u(k)
3976 usumsqder=usumsqder+ud(j)*uprod2
3978 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3979 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3980 estr=estr+uprod/usum
3982 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3990 C--------------------------------------------------------------------------
3991 subroutine ebend(etheta,ethetacnstr)
3993 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3994 C angles gamma and its derivatives in consecutive thetas and gammas.
3996 implicit real*8 (a-h,o-z)
3997 include 'DIMENSIONS'
3998 include 'DIMENSIONS.ZSCOPT'
3999 include 'COMMON.LOCAL'
4000 include 'COMMON.GEO'
4001 include 'COMMON.INTERACT'
4002 include 'COMMON.DERIV'
4003 include 'COMMON.VAR'
4004 include 'COMMON.CHAIN'
4005 include 'COMMON.IOUNITS'
4006 include 'COMMON.NAMES'
4007 include 'COMMON.FFIELD'
4008 include 'COMMON.TORCNSTR'
4009 common /calcthet/ term1,term2,termm,diffak,ratak,
4010 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4011 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4012 double precision y(2),z(2)
4014 c time11=dexp(-2*time)
4017 c write (iout,*) "nres",nres
4018 c write (*,'(a,i2)') 'EBEND ICG=',icg
4019 c write (iout,*) ithet_start,ithet_end
4020 do i=ithet_start,ithet_end
4021 C if (itype(i-1).eq.ntyp1) cycle
4023 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4024 & .or.itype(i).eq.ntyp1) cycle
4025 C Zero the energy function and its derivative at 0 or pi.
4026 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4028 ichir1=isign(1,itype(i-2))
4029 ichir2=isign(1,itype(i))
4030 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4031 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4032 if (itype(i-1).eq.10) then
4033 itype1=isign(10,itype(i-2))
4034 ichir11=isign(1,itype(i-2))
4035 ichir12=isign(1,itype(i-2))
4036 itype2=isign(10,itype(i))
4037 ichir21=isign(1,itype(i))
4038 ichir22=isign(1,itype(i))
4045 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4049 c call proc_proc(phii,icrc)
4050 if (icrc.eq.1) phii=150.0
4061 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4065 c call proc_proc(phii1,icrc)
4066 if (icrc.eq.1) phii1=150.0
4078 C Calculate the "mean" value of theta from the part of the distribution
4079 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4080 C In following comments this theta will be referred to as t_c.
4081 thet_pred_mean=0.0d0
4083 athetk=athet(k,it,ichir1,ichir2)
4084 bthetk=bthet(k,it,ichir1,ichir2)
4086 athetk=athet(k,itype1,ichir11,ichir12)
4087 bthetk=bthet(k,itype2,ichir21,ichir22)
4089 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4091 c write (iout,*) "thet_pred_mean",thet_pred_mean
4092 dthett=thet_pred_mean*ssd
4093 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4094 c write (iout,*) "thet_pred_mean",thet_pred_mean
4095 C Derivatives of the "mean" values in gamma1 and gamma2.
4096 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4097 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4098 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4099 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4101 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4102 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4103 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4104 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4106 if (theta(i).gt.pi-delta) then
4107 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4109 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4110 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4111 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4113 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4115 else if (theta(i).lt.delta) then
4116 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4117 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4118 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4120 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4121 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4124 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4127 etheta=etheta+ethetai
4128 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4129 c & 'ebend',i,ethetai,theta(i),itype(i)
4130 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4131 c & rad2deg*phii,rad2deg*phii1,ethetai
4132 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4133 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4134 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4138 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4139 do i=1,ntheta_constr
4140 itheta=itheta_constr(i)
4141 thetiii=theta(itheta)
4142 difi=pinorm(thetiii-theta_constr0(i))
4143 if (difi.gt.theta_drange(i)) then
4144 difi=difi-theta_drange(i)
4145 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4146 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4147 & +for_thet_constr(i)*difi**3
4148 else if (difi.lt.-drange(i)) then
4150 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4151 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4152 & +for_thet_constr(i)*difi**3
4156 C if (energy_dec) then
4157 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4158 C & i,itheta,rad2deg*thetiii,
4159 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4160 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4161 C & gloc(itheta+nphi-2,icg)
4164 C Ufff.... We've done all this!!!
4167 C---------------------------------------------------------------------------
4168 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4170 implicit real*8 (a-h,o-z)
4171 include 'DIMENSIONS'
4172 include 'COMMON.LOCAL'
4173 include 'COMMON.IOUNITS'
4174 common /calcthet/ term1,term2,termm,diffak,ratak,
4175 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4176 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4177 C Calculate the contributions to both Gaussian lobes.
4178 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4179 C The "polynomial part" of the "standard deviation" of this part of
4183 sig=sig*thet_pred_mean+polthet(j,it)
4185 C Derivative of the "interior part" of the "standard deviation of the"
4186 C gamma-dependent Gaussian lobe in t_c.
4187 sigtc=3*polthet(3,it)
4189 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4192 C Set the parameters of both Gaussian lobes of the distribution.
4193 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4194 fac=sig*sig+sigc0(it)
4197 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4198 sigsqtc=-4.0D0*sigcsq*sigtc
4199 c print *,i,sig,sigtc,sigsqtc
4200 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4201 sigtc=-sigtc/(fac*fac)
4202 C Following variable is sigma(t_c)**(-2)
4203 sigcsq=sigcsq*sigcsq
4205 sig0inv=1.0D0/sig0i**2
4206 delthec=thetai-thet_pred_mean
4207 delthe0=thetai-theta0i
4208 term1=-0.5D0*sigcsq*delthec*delthec
4209 term2=-0.5D0*sig0inv*delthe0*delthe0
4210 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4211 C NaNs in taking the logarithm. We extract the largest exponent which is added
4212 C to the energy (this being the log of the distribution) at the end of energy
4213 C term evaluation for this virtual-bond angle.
4214 if (term1.gt.term2) then
4216 term2=dexp(term2-termm)
4220 term1=dexp(term1-termm)
4223 C The ratio between the gamma-independent and gamma-dependent lobes of
4224 C the distribution is a Gaussian function of thet_pred_mean too.
4225 diffak=gthet(2,it)-thet_pred_mean
4226 ratak=diffak/gthet(3,it)**2
4227 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4228 C Let's differentiate it in thet_pred_mean NOW.
4230 C Now put together the distribution terms to make complete distribution.
4231 termexp=term1+ak*term2
4232 termpre=sigc+ak*sig0i
4233 C Contribution of the bending energy from this theta is just the -log of
4234 C the sum of the contributions from the two lobes and the pre-exponential
4235 C factor. Simple enough, isn't it?
4236 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4237 C NOW the derivatives!!!
4238 C 6/6/97 Take into account the deformation.
4239 E_theta=(delthec*sigcsq*term1
4240 & +ak*delthe0*sig0inv*term2)/termexp
4241 E_tc=((sigtc+aktc*sig0i)/termpre
4242 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4243 & aktc*term2)/termexp)
4246 c-----------------------------------------------------------------------------
4247 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4248 implicit real*8 (a-h,o-z)
4249 include 'DIMENSIONS'
4250 include 'COMMON.LOCAL'
4251 include 'COMMON.IOUNITS'
4252 common /calcthet/ term1,term2,termm,diffak,ratak,
4253 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4254 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4255 delthec=thetai-thet_pred_mean
4256 delthe0=thetai-theta0i
4257 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4258 t3 = thetai-thet_pred_mean
4262 t14 = t12+t6*sigsqtc
4264 t21 = thetai-theta0i
4270 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4271 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4272 & *(-t12*t9-ak*sig0inv*t27)
4276 C--------------------------------------------------------------------------
4277 subroutine ebend(etheta,ethetacnstr)
4279 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4280 C angles gamma and its derivatives in consecutive thetas and gammas.
4281 C ab initio-derived potentials from
4282 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4284 implicit real*8 (a-h,o-z)
4285 include 'DIMENSIONS'
4286 include 'DIMENSIONS.ZSCOPT'
4287 include 'COMMON.LOCAL'
4288 include 'COMMON.GEO'
4289 include 'COMMON.INTERACT'
4290 include 'COMMON.DERIV'
4291 include 'COMMON.VAR'
4292 include 'COMMON.CHAIN'
4293 include 'COMMON.IOUNITS'
4294 include 'COMMON.NAMES'
4295 include 'COMMON.FFIELD'
4296 include 'COMMON.CONTROL'
4297 include 'COMMON.TORCNSTR'
4298 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4299 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4300 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4301 & sinph1ph2(maxdouble,maxdouble)
4302 logical lprn /.false./, lprn1 /.false./
4304 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4305 do i=ithet_start,ithet_end
4307 C if (itype(i-1).eq.ntyp1) cycle
4309 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4310 & .or.itype(i).eq.ntyp1) cycle
4311 if (iabs(itype(i+1)).eq.20) iblock=2
4312 if (iabs(itype(i+1)).ne.20) iblock=1
4316 theti2=0.5d0*theta(i)
4317 ityp2=ithetyp((itype(i-1)))
4319 coskt(k)=dcos(k*theti2)
4320 sinkt(k)=dsin(k*theti2)
4330 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4333 if (phii.ne.phii) phii=150.0
4337 ityp1=ithetyp((itype(i-2)))
4339 cosph1(k)=dcos(k*phii)
4340 sinph1(k)=dsin(k*phii)
4346 ityp1=ithetyp((itype(i-2)))
4352 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4355 if (phii1.ne.phii1) phii1=150.0
4360 ityp3=ithetyp((itype(i)))
4362 cosph2(k)=dcos(k*phii1)
4363 sinph2(k)=dsin(k*phii1)
4368 ityp3=ithetyp((itype(i)))
4374 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4375 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4377 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4380 ccl=cosph1(l)*cosph2(k-l)
4381 ssl=sinph1(l)*sinph2(k-l)
4382 scl=sinph1(l)*cosph2(k-l)
4383 csl=cosph1(l)*sinph2(k-l)
4384 cosph1ph2(l,k)=ccl-ssl
4385 cosph1ph2(k,l)=ccl+ssl
4386 sinph1ph2(l,k)=scl+csl
4387 sinph1ph2(k,l)=scl-csl
4391 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4392 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4393 write (iout,*) "coskt and sinkt"
4395 write (iout,*) k,coskt(k),sinkt(k)
4399 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4400 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4403 & write (iout,*) "k",k,"
4404 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4405 & " ethetai",ethetai
4408 write (iout,*) "cosph and sinph"
4410 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4412 write (iout,*) "cosph1ph2 and sinph2ph2"
4415 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4416 & sinph1ph2(l,k),sinph1ph2(k,l)
4419 write(iout,*) "ethetai",ethetai
4423 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4424 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4425 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4426 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4427 ethetai=ethetai+sinkt(m)*aux
4428 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4429 dephii=dephii+k*sinkt(m)*(
4430 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4431 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4432 dephii1=dephii1+k*sinkt(m)*(
4433 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4434 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4436 & write (iout,*) "m",m," k",k," bbthet",
4437 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4438 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4439 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4440 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4444 & write(iout,*) "ethetai",ethetai
4448 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4449 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4450 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4451 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4452 ethetai=ethetai+sinkt(m)*aux
4453 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4454 dephii=dephii+l*sinkt(m)*(
4455 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4456 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4457 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4458 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4459 dephii1=dephii1+(k-l)*sinkt(m)*(
4460 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4461 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4462 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4463 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4465 write (iout,*) "m",m," k",k," l",l," ffthet",
4466 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4467 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4468 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4469 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4470 & " ethetai",ethetai
4471 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4472 & cosph1ph2(k,l)*sinkt(m),
4473 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4479 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4480 & i,theta(i)*rad2deg,phii*rad2deg,
4481 & phii1*rad2deg,ethetai
4482 etheta=etheta+ethetai
4483 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4484 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4485 c gloc(nphi+i-2,icg)=wang*dethetai
4486 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4490 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4491 do i=1,ntheta_constr
4492 itheta=itheta_constr(i)
4493 thetiii=theta(itheta)
4494 difi=pinorm(thetiii-theta_constr0(i))
4495 if (difi.gt.theta_drange(i)) then
4496 difi=difi-theta_drange(i)
4497 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4498 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4499 & +for_thet_constr(i)*difi**3
4500 else if (difi.lt.-drange(i)) then
4502 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4503 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4504 & +for_thet_constr(i)*difi**3
4508 C if (energy_dec) then
4509 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4510 C & i,itheta,rad2deg*thetiii,
4511 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4512 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4513 C & gloc(itheta+nphi-2,icg)
4520 c-----------------------------------------------------------------------------
4521 subroutine esc(escloc)
4522 C Calculate the local energy of a side chain and its derivatives in the
4523 C corresponding virtual-bond valence angles THETA and the spherical angles
4525 implicit real*8 (a-h,o-z)
4526 include 'DIMENSIONS'
4527 include 'DIMENSIONS.ZSCOPT'
4528 include 'COMMON.GEO'
4529 include 'COMMON.LOCAL'
4530 include 'COMMON.VAR'
4531 include 'COMMON.INTERACT'
4532 include 'COMMON.DERIV'
4533 include 'COMMON.CHAIN'
4534 include 'COMMON.IOUNITS'
4535 include 'COMMON.NAMES'
4536 include 'COMMON.FFIELD'
4537 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4538 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4539 common /sccalc/ time11,time12,time112,theti,it,nlobit
4542 C write (iout,*) 'ESC'
4543 do i=loc_start,loc_end
4545 if (it.eq.ntyp1) cycle
4546 if (it.eq.10) goto 1
4547 nlobit=nlob(iabs(it))
4548 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4549 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4550 theti=theta(i+1)-pipol
4554 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4556 if (x(2).gt.pi-delta) then
4560 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4562 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4563 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4565 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4566 & ddersc0(1),dersc(1))
4567 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4568 & ddersc0(3),dersc(3))
4570 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4572 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4573 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4574 & dersc0(2),esclocbi,dersc02)
4575 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4577 call splinthet(x(2),0.5d0*delta,ss,ssd)
4582 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4584 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4585 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4587 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4589 c write (iout,*) escloci
4590 else if (x(2).lt.delta) then
4594 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4596 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4597 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4599 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4600 & ddersc0(1),dersc(1))
4601 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4602 & ddersc0(3),dersc(3))
4604 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4606 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4607 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4608 & dersc0(2),esclocbi,dersc02)
4609 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4614 call splinthet(x(2),0.5d0*delta,ss,ssd)
4616 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4618 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4619 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4621 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4622 C write (iout,*) 'i=',i, escloci
4624 call enesc(x,escloci,dersc,ddummy,.false.)
4627 escloc=escloc+escloci
4628 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4629 write (iout,'(a6,i5,0pf7.3)')
4630 & 'escloc',i,escloci
4632 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4634 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4635 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4640 C---------------------------------------------------------------------------
4641 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4642 implicit real*8 (a-h,o-z)
4643 include 'DIMENSIONS'
4644 include 'COMMON.GEO'
4645 include 'COMMON.LOCAL'
4646 include 'COMMON.IOUNITS'
4647 common /sccalc/ time11,time12,time112,theti,it,nlobit
4648 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4649 double precision contr(maxlob,-1:1)
4651 c write (iout,*) 'it=',it,' nlobit=',nlobit
4655 if (mixed) ddersc(j)=0.0d0
4659 C Because of periodicity of the dependence of the SC energy in omega we have
4660 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4661 C To avoid underflows, first compute & store the exponents.
4669 z(k)=x(k)-censc(k,j,it)
4674 Axk=Axk+gaussc(l,k,j,it)*z(l)
4680 expfac=expfac+Ax(k,j,iii)*z(k)
4688 C As in the case of ebend, we want to avoid underflows in exponentiation and
4689 C subsequent NaNs and INFs in energy calculation.
4690 C Find the largest exponent
4694 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4698 cd print *,'it=',it,' emin=',emin
4700 C Compute the contribution to SC energy and derivatives
4704 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4705 cd print *,'j=',j,' expfac=',expfac
4706 escloc_i=escloc_i+expfac
4708 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4712 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4713 & +gaussc(k,2,j,it))*expfac
4720 dersc(1)=dersc(1)/cos(theti)**2
4721 ddersc(1)=ddersc(1)/cos(theti)**2
4724 escloci=-(dlog(escloc_i)-emin)
4726 dersc(j)=dersc(j)/escloc_i
4730 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4735 C------------------------------------------------------------------------------
4736 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4737 implicit real*8 (a-h,o-z)
4738 include 'DIMENSIONS'
4739 include 'COMMON.GEO'
4740 include 'COMMON.LOCAL'
4741 include 'COMMON.IOUNITS'
4742 common /sccalc/ time11,time12,time112,theti,it,nlobit
4743 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4744 double precision contr(maxlob)
4755 z(k)=x(k)-censc(k,j,it)
4761 Axk=Axk+gaussc(l,k,j,it)*z(l)
4767 expfac=expfac+Ax(k,j)*z(k)
4772 C As in the case of ebend, we want to avoid underflows in exponentiation and
4773 C subsequent NaNs and INFs in energy calculation.
4774 C Find the largest exponent
4777 if (emin.gt.contr(j)) emin=contr(j)
4781 C Compute the contribution to SC energy and derivatives
4785 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4786 escloc_i=escloc_i+expfac
4788 dersc(k)=dersc(k)+Ax(k,j)*expfac
4790 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4791 & +gaussc(1,2,j,it))*expfac
4795 dersc(1)=dersc(1)/cos(theti)**2
4796 dersc12=dersc12/cos(theti)**2
4797 escloci=-(dlog(escloc_i)-emin)
4799 dersc(j)=dersc(j)/escloc_i
4801 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4805 c----------------------------------------------------------------------------------
4806 subroutine esc(escloc)
4807 C Calculate the local energy of a side chain and its derivatives in the
4808 C corresponding virtual-bond valence angles THETA and the spherical angles
4809 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4810 C added by Urszula Kozlowska. 07/11/2007
4812 implicit real*8 (a-h,o-z)
4813 include 'DIMENSIONS'
4814 include 'DIMENSIONS.ZSCOPT'
4815 include 'COMMON.GEO'
4816 include 'COMMON.LOCAL'
4817 include 'COMMON.VAR'
4818 include 'COMMON.SCROT'
4819 include 'COMMON.INTERACT'
4820 include 'COMMON.DERIV'
4821 include 'COMMON.CHAIN'
4822 include 'COMMON.IOUNITS'
4823 include 'COMMON.NAMES'
4824 include 'COMMON.FFIELD'
4825 include 'COMMON.CONTROL'
4826 include 'COMMON.VECTORS'
4827 double precision x_prime(3),y_prime(3),z_prime(3)
4828 & , sumene,dsc_i,dp2_i,x(65),
4829 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4830 & de_dxx,de_dyy,de_dzz,de_dt
4831 double precision s1_t,s1_6_t,s2_t,s2_6_t
4833 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4834 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4835 & dt_dCi(3),dt_dCi1(3)
4836 common /sccalc/ time11,time12,time112,theti,it,nlobit
4839 do i=loc_start,loc_end
4840 if (itype(i).eq.ntyp1) cycle
4841 costtab(i+1) =dcos(theta(i+1))
4842 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4843 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4844 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4845 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4846 cosfac=dsqrt(cosfac2)
4847 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4848 sinfac=dsqrt(sinfac2)
4850 if (it.eq.10) goto 1
4852 C Compute the axes of tghe local cartesian coordinates system; store in
4853 c x_prime, y_prime and z_prime
4860 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4861 C & dc_norm(3,i+nres)
4863 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4864 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4867 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4870 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4871 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4872 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4873 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4874 c & " xy",scalar(x_prime(1),y_prime(1)),
4875 c & " xz",scalar(x_prime(1),z_prime(1)),
4876 c & " yy",scalar(y_prime(1),y_prime(1)),
4877 c & " yz",scalar(y_prime(1),z_prime(1)),
4878 c & " zz",scalar(z_prime(1),z_prime(1))
4880 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4881 C to local coordinate system. Store in xx, yy, zz.
4887 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4888 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4889 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4896 C Compute the energy of the ith side cbain
4898 c write (2,*) "xx",xx," yy",yy," zz",zz
4901 x(j) = sc_parmin(j,it)
4904 Cc diagnostics - remove later
4906 yy1 = dsin(alph(2))*dcos(omeg(2))
4907 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4908 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4909 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4911 C," --- ", xx_w,yy_w,zz_w
4914 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4915 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4917 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4918 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4920 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4921 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4922 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4923 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4924 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4926 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4927 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4928 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4929 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4930 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4932 dsc_i = 0.743d0+x(61)
4934 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4935 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4936 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4937 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4938 s1=(1+x(63))/(0.1d0 + dscp1)
4939 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4940 s2=(1+x(65))/(0.1d0 + dscp2)
4941 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4942 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4943 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4944 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4946 c & dscp1,dscp2,sumene
4947 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4948 escloc = escloc + sumene
4949 c write (2,*) "escloc",escloc
4950 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4952 if (.not. calc_grad) goto 1
4955 C This section to check the numerical derivatives of the energy of ith side
4956 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4957 C #define DEBUG in the code to turn it on.
4959 write (2,*) "sumene =",sumene
4963 write (2,*) xx,yy,zz
4964 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4965 de_dxx_num=(sumenep-sumene)/aincr
4967 write (2,*) "xx+ sumene from enesc=",sumenep
4970 write (2,*) xx,yy,zz
4971 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4972 de_dyy_num=(sumenep-sumene)/aincr
4974 write (2,*) "yy+ sumene from enesc=",sumenep
4977 write (2,*) xx,yy,zz
4978 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4979 de_dzz_num=(sumenep-sumene)/aincr
4981 write (2,*) "zz+ sumene from enesc=",sumenep
4982 costsave=cost2tab(i+1)
4983 sintsave=sint2tab(i+1)
4984 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4985 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4986 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4987 de_dt_num=(sumenep-sumene)/aincr
4988 write (2,*) " t+ sumene from enesc=",sumenep
4989 cost2tab(i+1)=costsave
4990 sint2tab(i+1)=sintsave
4991 C End of diagnostics section.
4994 C Compute the gradient of esc
4996 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4997 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4998 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4999 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5000 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5001 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5002 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5003 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5004 pom1=(sumene3*sint2tab(i+1)+sumene1)
5005 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5006 pom2=(sumene4*cost2tab(i+1)+sumene2)
5007 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5008 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5009 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5010 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5012 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5013 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5014 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5016 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5017 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5018 & +(pom1+pom2)*pom_dx
5020 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5023 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5024 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5025 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5027 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5028 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5029 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5030 & +x(59)*zz**2 +x(60)*xx*zz
5031 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5032 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5033 & +(pom1-pom2)*pom_dy
5035 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5038 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5039 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5040 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5041 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5042 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5043 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5044 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5045 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5047 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5050 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5051 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5052 & +pom1*pom_dt1+pom2*pom_dt2
5054 write(2,*), "de_dt = ", de_dt,de_dt_num
5058 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5059 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5060 cosfac2xx=cosfac2*xx
5061 sinfac2yy=sinfac2*yy
5063 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5065 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5067 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5068 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5069 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5070 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5071 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5072 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5073 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5074 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5075 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5076 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5080 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5081 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5082 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5083 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5086 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5087 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5088 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5090 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5091 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5095 dXX_Ctab(k,i)=dXX_Ci(k)
5096 dXX_C1tab(k,i)=dXX_Ci1(k)
5097 dYY_Ctab(k,i)=dYY_Ci(k)
5098 dYY_C1tab(k,i)=dYY_Ci1(k)
5099 dZZ_Ctab(k,i)=dZZ_Ci(k)
5100 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5101 dXX_XYZtab(k,i)=dXX_XYZ(k)
5102 dYY_XYZtab(k,i)=dYY_XYZ(k)
5103 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5107 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5108 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5109 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5110 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5111 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5113 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5114 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5115 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5116 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5117 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5118 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5119 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5120 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5122 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5123 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5125 C to check gradient call subroutine check_grad
5132 c------------------------------------------------------------------------------
5133 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5135 C This procedure calculates two-body contact function g(rij) and its derivative:
5138 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5141 C where x=(rij-r0ij)/delta
5143 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5146 double precision rij,r0ij,eps0ij,fcont,fprimcont
5147 double precision x,x2,x4,delta
5151 if (x.lt.-1.0D0) then
5154 else if (x.le.1.0D0) then
5157 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5158 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5165 c------------------------------------------------------------------------------
5166 subroutine splinthet(theti,delta,ss,ssder)
5167 implicit real*8 (a-h,o-z)
5168 include 'DIMENSIONS'
5169 include 'DIMENSIONS.ZSCOPT'
5170 include 'COMMON.VAR'
5171 include 'COMMON.GEO'
5174 if (theti.gt.pipol) then
5175 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5177 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5182 c------------------------------------------------------------------------------
5183 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5185 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5186 double precision ksi,ksi2,ksi3,a1,a2,a3
5187 a1=fprim0*delta/(f1-f0)
5193 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5194 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5197 c------------------------------------------------------------------------------
5198 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5200 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5201 double precision ksi,ksi2,ksi3,a1,a2,a3
5206 a2=3*(f1x-f0x)-2*fprim0x*delta
5207 a3=fprim0x*delta-2*(f1x-f0x)
5208 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5211 C-----------------------------------------------------------------------------
5213 C-----------------------------------------------------------------------------
5214 subroutine etor(etors,edihcnstr,fact)
5215 implicit real*8 (a-h,o-z)
5216 include 'DIMENSIONS'
5217 include 'DIMENSIONS.ZSCOPT'
5218 include 'COMMON.VAR'
5219 include 'COMMON.GEO'
5220 include 'COMMON.LOCAL'
5221 include 'COMMON.TORSION'
5222 include 'COMMON.INTERACT'
5223 include 'COMMON.DERIV'
5224 include 'COMMON.CHAIN'
5225 include 'COMMON.NAMES'
5226 include 'COMMON.IOUNITS'
5227 include 'COMMON.FFIELD'
5228 include 'COMMON.TORCNSTR'
5230 C Set lprn=.true. for debugging
5234 do i=iphi_start,iphi_end
5235 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5236 & .or. itype(i).eq.ntyp1) cycle
5237 itori=itortyp(itype(i-2))
5238 itori1=itortyp(itype(i-1))
5241 C Proline-Proline pair is a special case...
5242 if (itori.eq.3 .and. itori1.eq.3) then
5243 if (phii.gt.-dwapi3) then
5245 fac=1.0D0/(1.0D0-cosphi)
5246 etorsi=v1(1,3,3)*fac
5247 etorsi=etorsi+etorsi
5248 etors=etors+etorsi-v1(1,3,3)
5249 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5252 v1ij=v1(j+1,itori,itori1)
5253 v2ij=v2(j+1,itori,itori1)
5256 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5257 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5261 v1ij=v1(j,itori,itori1)
5262 v2ij=v2(j,itori,itori1)
5265 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5266 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5270 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5271 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5272 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5273 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5274 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5276 ! 6/20/98 - dihedral angle constraints
5279 itori=idih_constr(i)
5282 if (difi.gt.drange(i)) then
5284 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5285 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5286 else if (difi.lt.-drange(i)) then
5288 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5289 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5291 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5292 C & i,itori,rad2deg*phii,
5293 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5295 ! write (iout,*) 'edihcnstr',edihcnstr
5298 c------------------------------------------------------------------------------
5300 subroutine etor(etors,edihcnstr,fact)
5301 implicit real*8 (a-h,o-z)
5302 include 'DIMENSIONS'
5303 include 'DIMENSIONS.ZSCOPT'
5304 include 'COMMON.VAR'
5305 include 'COMMON.GEO'
5306 include 'COMMON.LOCAL'
5307 include 'COMMON.TORSION'
5308 include 'COMMON.INTERACT'
5309 include 'COMMON.DERIV'
5310 include 'COMMON.CHAIN'
5311 include 'COMMON.NAMES'
5312 include 'COMMON.IOUNITS'
5313 include 'COMMON.FFIELD'
5314 include 'COMMON.TORCNSTR'
5316 C Set lprn=.true. for debugging
5320 do i=iphi_start,iphi_end
5322 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5323 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5324 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5325 C & .or. itype(i).eq.ntyp1) cycle
5326 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5327 if (iabs(itype(i)).eq.20) then
5332 itori=itortyp(itype(i-2))
5333 itori1=itortyp(itype(i-1))
5336 C Regular cosine and sine terms
5337 do j=1,nterm(itori,itori1,iblock)
5338 v1ij=v1(j,itori,itori1,iblock)
5339 v2ij=v2(j,itori,itori1,iblock)
5342 etors=etors+v1ij*cosphi+v2ij*sinphi
5343 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5347 C E = SUM ----------------------------------- - v1
5348 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5350 cosphi=dcos(0.5d0*phii)
5351 sinphi=dsin(0.5d0*phii)
5352 do j=1,nlor(itori,itori1,iblock)
5353 vl1ij=vlor1(j,itori,itori1)
5354 vl2ij=vlor2(j,itori,itori1)
5355 vl3ij=vlor3(j,itori,itori1)
5356 pom=vl2ij*cosphi+vl3ij*sinphi
5357 pom1=1.0d0/(pom*pom+1.0d0)
5358 etors=etors+vl1ij*pom1
5359 c if (energy_dec) etors_ii=etors_ii+
5362 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5364 C Subtract the constant term
5365 etors=etors-v0(itori,itori1,iblock)
5367 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5368 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5369 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5370 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5371 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5374 ! 6/20/98 - dihedral angle constraints
5377 itori=idih_constr(i)
5379 difi=pinorm(phii-phi0(i))
5381 if (difi.gt.drange(i)) then
5383 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5384 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5385 edihi=0.25d0*ftors(i)*difi**4
5386 else if (difi.lt.-drange(i)) then
5388 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5389 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5390 edihi=0.25d0*ftors(i)*difi**4
5394 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5395 & i,itori,rad2deg*phii,
5396 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5397 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5399 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5400 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5402 ! write (iout,*) 'edihcnstr',edihcnstr
5405 c----------------------------------------------------------------------------
5406 subroutine etor_d(etors_d,fact2)
5407 C 6/23/01 Compute double torsional energy
5408 implicit real*8 (a-h,o-z)
5409 include 'DIMENSIONS'
5410 include 'DIMENSIONS.ZSCOPT'
5411 include 'COMMON.VAR'
5412 include 'COMMON.GEO'
5413 include 'COMMON.LOCAL'
5414 include 'COMMON.TORSION'
5415 include 'COMMON.INTERACT'
5416 include 'COMMON.DERIV'
5417 include 'COMMON.CHAIN'
5418 include 'COMMON.NAMES'
5419 include 'COMMON.IOUNITS'
5420 include 'COMMON.FFIELD'
5421 include 'COMMON.TORCNSTR'
5423 C Set lprn=.true. for debugging
5427 do i=iphi_start,iphi_end-1
5429 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5430 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5431 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5432 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5433 & (itype(i+1).eq.ntyp1)) cycle
5434 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5436 itori=itortyp(itype(i-2))
5437 itori1=itortyp(itype(i-1))
5438 itori2=itortyp(itype(i))
5444 if (iabs(itype(i+1)).eq.20) iblock=2
5445 C Regular cosine and sine terms
5446 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5447 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5448 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5449 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5450 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5451 cosphi1=dcos(j*phii)
5452 sinphi1=dsin(j*phii)
5453 cosphi2=dcos(j*phii1)
5454 sinphi2=dsin(j*phii1)
5455 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5456 & v2cij*cosphi2+v2sij*sinphi2
5457 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5458 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5460 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5462 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5463 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5464 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5465 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5466 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5467 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5468 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5469 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5470 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5471 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5472 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5473 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5474 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5475 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5478 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5479 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5485 c------------------------------------------------------------------------------
5486 subroutine eback_sc_corr(esccor)
5487 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5488 c conformational states; temporarily implemented as differences
5489 c between UNRES torsional potentials (dependent on three types of
5490 c residues) and the torsional potentials dependent on all 20 types
5491 c of residues computed from AM1 energy surfaces of terminally-blocked
5492 c amino-acid residues.
5493 implicit real*8 (a-h,o-z)
5494 include 'DIMENSIONS'
5495 include 'DIMENSIONS.ZSCOPT'
5496 include 'COMMON.VAR'
5497 include 'COMMON.GEO'
5498 include 'COMMON.LOCAL'
5499 include 'COMMON.TORSION'
5500 include 'COMMON.SCCOR'
5501 include 'COMMON.INTERACT'
5502 include 'COMMON.DERIV'
5503 include 'COMMON.CHAIN'
5504 include 'COMMON.NAMES'
5505 include 'COMMON.IOUNITS'
5506 include 'COMMON.FFIELD'
5507 include 'COMMON.CONTROL'
5509 C Set lprn=.true. for debugging
5512 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5514 do i=itau_start,itau_end
5515 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5517 isccori=isccortyp(itype(i-2))
5518 isccori1=isccortyp(itype(i-1))
5520 do intertyp=1,3 !intertyp
5521 cc Added 09 May 2012 (Adasko)
5522 cc Intertyp means interaction type of backbone mainchain correlation:
5523 c 1 = SC...Ca...Ca...Ca
5524 c 2 = Ca...Ca...Ca...SC
5525 c 3 = SC...Ca...Ca...SCi
5527 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5528 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5529 & (itype(i-1).eq.ntyp1)))
5530 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5531 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5532 & .or.(itype(i).eq.ntyp1)))
5533 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5534 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5535 & (itype(i-3).eq.ntyp1)))) cycle
5536 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5537 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5539 do j=1,nterm_sccor(isccori,isccori1)
5540 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5541 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5542 cosphi=dcos(j*tauangle(intertyp,i))
5543 sinphi=dsin(j*tauangle(intertyp,i))
5544 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5545 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5547 C write (iout,*)"EBACK_SC_COR",esccor,i
5548 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5549 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5550 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5552 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5553 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5554 & (v1sccor(j,1,itori,itori1),j=1,6)
5555 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5556 c gsccor_loc(i-3)=gloci
5561 c------------------------------------------------------------------------------
5562 subroutine multibody(ecorr)
5563 C This subroutine calculates multi-body contributions to energy following
5564 C the idea of Skolnick et al. If side chains I and J make a contact and
5565 C at the same time side chains I+1 and J+1 make a contact, an extra
5566 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5567 implicit real*8 (a-h,o-z)
5568 include 'DIMENSIONS'
5569 include 'COMMON.IOUNITS'
5570 include 'COMMON.DERIV'
5571 include 'COMMON.INTERACT'
5572 include 'COMMON.CONTACTS'
5573 double precision gx(3),gx1(3)
5576 C Set lprn=.true. for debugging
5580 write (iout,'(a)') 'Contact function values:'
5582 write (iout,'(i2,20(1x,i2,f10.5))')
5583 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5598 num_conti=num_cont(i)
5599 num_conti1=num_cont(i1)
5604 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5605 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5606 cd & ' ishift=',ishift
5607 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5608 C The system gains extra energy.
5609 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5610 endif ! j1==j+-ishift
5619 c------------------------------------------------------------------------------
5620 double precision function esccorr(i,j,k,l,jj,kk)
5621 implicit real*8 (a-h,o-z)
5622 include 'DIMENSIONS'
5623 include 'COMMON.IOUNITS'
5624 include 'COMMON.DERIV'
5625 include 'COMMON.INTERACT'
5626 include 'COMMON.CONTACTS'
5627 double precision gx(3),gx1(3)
5632 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5633 C Calculate the multi-body contribution to energy.
5634 C Calculate multi-body contributions to the gradient.
5635 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5636 cd & k,l,(gacont(m,kk,k),m=1,3)
5638 gx(m) =ekl*gacont(m,jj,i)
5639 gx1(m)=eij*gacont(m,kk,k)
5640 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5641 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5642 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5643 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5647 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5652 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5658 c------------------------------------------------------------------------------
5660 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5661 implicit real*8 (a-h,o-z)
5662 include 'DIMENSIONS'
5663 integer dimen1,dimen2,atom,indx
5664 double precision buffer(dimen1,dimen2)
5665 double precision zapas
5666 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5667 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5668 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5669 num_kont=num_cont_hb(atom)
5673 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5676 buffer(i,indx+22)=facont_hb(i,atom)
5677 buffer(i,indx+23)=ees0p(i,atom)
5678 buffer(i,indx+24)=ees0m(i,atom)
5679 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5681 buffer(1,indx+26)=dfloat(num_kont)
5684 c------------------------------------------------------------------------------
5685 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5686 implicit real*8 (a-h,o-z)
5687 include 'DIMENSIONS'
5688 integer dimen1,dimen2,atom,indx
5689 double precision buffer(dimen1,dimen2)
5690 double precision zapas
5691 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5692 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5693 & ees0m(ntyp,maxres),
5694 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5695 num_kont=buffer(1,indx+26)
5696 num_kont_old=num_cont_hb(atom)
5697 num_cont_hb(atom)=num_kont+num_kont_old
5702 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5705 facont_hb(ii,atom)=buffer(i,indx+22)
5706 ees0p(ii,atom)=buffer(i,indx+23)
5707 ees0m(ii,atom)=buffer(i,indx+24)
5708 jcont_hb(ii,atom)=buffer(i,indx+25)
5712 c------------------------------------------------------------------------------
5714 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5715 C This subroutine calculates multi-body contributions to hydrogen-bonding
5716 implicit real*8 (a-h,o-z)
5717 include 'DIMENSIONS'
5718 include 'DIMENSIONS.ZSCOPT'
5719 include 'COMMON.IOUNITS'
5721 include 'COMMON.INFO'
5723 include 'COMMON.FFIELD'
5724 include 'COMMON.DERIV'
5725 include 'COMMON.INTERACT'
5726 include 'COMMON.CONTACTS'
5728 parameter (max_cont=maxconts)
5729 parameter (max_dim=2*(8*3+2))
5730 parameter (msglen1=max_cont*max_dim*4)
5731 parameter (msglen2=2*msglen1)
5732 integer source,CorrelType,CorrelID,Error
5733 double precision buffer(max_cont,max_dim)
5735 double precision gx(3),gx1(3)
5738 C Set lprn=.true. for debugging
5743 if (fgProcs.le.1) goto 30
5745 write (iout,'(a)') 'Contact function values:'
5747 write (iout,'(2i3,50(1x,i2,f5.2))')
5748 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5749 & j=1,num_cont_hb(i))
5752 C Caution! Following code assumes that electrostatic interactions concerning
5753 C a given atom are split among at most two processors!
5763 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5766 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5767 if (MyRank.gt.0) then
5768 C Send correlation contributions to the preceding processor
5770 nn=num_cont_hb(iatel_s)
5771 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5772 cd write (iout,*) 'The BUFFER array:'
5774 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5776 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5778 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5779 C Clear the contacts of the atom passed to the neighboring processor
5780 nn=num_cont_hb(iatel_s+1)
5782 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5784 num_cont_hb(iatel_s)=0
5786 cd write (iout,*) 'Processor ',MyID,MyRank,
5787 cd & ' is sending correlation contribution to processor',MyID-1,
5788 cd & ' msglen=',msglen
5789 cd write (*,*) 'Processor ',MyID,MyRank,
5790 cd & ' is sending correlation contribution to processor',MyID-1,
5791 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5792 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5793 cd write (iout,*) 'Processor ',MyID,
5794 cd & ' has sent correlation contribution to processor',MyID-1,
5795 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5796 cd write (*,*) 'Processor ',MyID,
5797 cd & ' has sent correlation contribution to processor',MyID-1,
5798 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5800 endif ! (MyRank.gt.0)
5804 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5805 if (MyRank.lt.fgProcs-1) then
5806 C Receive correlation contributions from the next processor
5808 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5809 cd write (iout,*) 'Processor',MyID,
5810 cd & ' is receiving correlation contribution from processor',MyID+1,
5811 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5812 cd write (*,*) 'Processor',MyID,
5813 cd & ' is receiving correlation contribution from processor',MyID+1,
5814 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5816 do while (nbytes.le.0)
5817 call mp_probe(MyID+1,CorrelType,nbytes)
5819 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5820 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5821 cd write (iout,*) 'Processor',MyID,
5822 cd & ' has received correlation contribution from processor',MyID+1,
5823 cd & ' msglen=',msglen,' nbytes=',nbytes
5824 cd write (iout,*) 'The received BUFFER array:'
5826 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5828 if (msglen.eq.msglen1) then
5829 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5830 else if (msglen.eq.msglen2) then
5831 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5832 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5835 & 'ERROR!!!! message length changed while processing correlations.'
5837 & 'ERROR!!!! message length changed while processing correlations.'
5838 call mp_stopall(Error)
5839 endif ! msglen.eq.msglen1
5840 endif ! MyRank.lt.fgProcs-1
5847 write (iout,'(a)') 'Contact function values:'
5849 write (iout,'(2i3,50(1x,i2,f5.2))')
5850 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5851 & j=1,num_cont_hb(i))
5855 C Remove the loop below after debugging !!!
5862 C Calculate the local-electrostatic correlation terms
5863 do i=iatel_s,iatel_e+1
5865 num_conti=num_cont_hb(i)
5866 num_conti1=num_cont_hb(i+1)
5871 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5872 c & ' jj=',jj,' kk=',kk
5873 if (j1.eq.j+1 .or. j1.eq.j-1) then
5874 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5875 C The system gains extra energy.
5876 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5878 else if (j1.eq.j) then
5879 C Contacts I-J and I-(J+1) occur simultaneously.
5880 C The system loses extra energy.
5881 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5886 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5887 c & ' jj=',jj,' kk=',kk
5889 C Contacts I-J and (I+1)-J occur simultaneously.
5890 C The system loses extra energy.
5891 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5898 c------------------------------------------------------------------------------
5899 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5901 C This subroutine calculates multi-body contributions to hydrogen-bonding
5902 implicit real*8 (a-h,o-z)
5903 include 'DIMENSIONS'
5904 include 'DIMENSIONS.ZSCOPT'
5905 include 'COMMON.IOUNITS'
5907 include 'COMMON.INFO'
5909 include 'COMMON.FFIELD'
5910 include 'COMMON.DERIV'
5911 include 'COMMON.INTERACT'
5912 include 'COMMON.CONTACTS'
5914 parameter (max_cont=maxconts)
5915 parameter (max_dim=2*(8*3+2))
5916 parameter (msglen1=max_cont*max_dim*4)
5917 parameter (msglen2=2*msglen1)
5918 integer source,CorrelType,CorrelID,Error
5919 double precision buffer(max_cont,max_dim)
5921 double precision gx(3),gx1(3)
5924 C Set lprn=.true. for debugging
5931 if (fgProcs.le.1) goto 30
5933 write (iout,'(a)') 'Contact function values:'
5935 write (iout,'(2i3,50(1x,i2,f5.2))')
5936 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5937 & j=1,num_cont_hb(i))
5940 C Caution! Following code assumes that electrostatic interactions concerning
5941 C a given atom are split among at most two processors!
5951 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5954 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5955 if (MyRank.gt.0) then
5956 C Send correlation contributions to the preceding processor
5958 nn=num_cont_hb(iatel_s)
5959 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5960 cd write (iout,*) 'The BUFFER array:'
5962 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5964 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5966 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5967 C Clear the contacts of the atom passed to the neighboring processor
5968 nn=num_cont_hb(iatel_s+1)
5970 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5972 num_cont_hb(iatel_s)=0
5974 cd write (iout,*) 'Processor ',MyID,MyRank,
5975 cd & ' is sending correlation contribution to processor',MyID-1,
5976 cd & ' msglen=',msglen
5977 cd write (*,*) 'Processor ',MyID,MyRank,
5978 cd & ' is sending correlation contribution to processor',MyID-1,
5979 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5980 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5981 cd write (iout,*) 'Processor ',MyID,
5982 cd & ' has sent correlation contribution to processor',MyID-1,
5983 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5984 cd write (*,*) 'Processor ',MyID,
5985 cd & ' has sent correlation contribution to processor',MyID-1,
5986 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5988 endif ! (MyRank.gt.0)
5992 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5993 if (MyRank.lt.fgProcs-1) then
5994 C Receive correlation contributions from the next processor
5996 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5997 cd write (iout,*) 'Processor',MyID,
5998 cd & ' is receiving correlation contribution from processor',MyID+1,
5999 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6000 cd write (*,*) 'Processor',MyID,
6001 cd & ' is receiving correlation contribution from processor',MyID+1,
6002 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6004 do while (nbytes.le.0)
6005 call mp_probe(MyID+1,CorrelType,nbytes)
6007 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6008 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6009 cd write (iout,*) 'Processor',MyID,
6010 cd & ' has received correlation contribution from processor',MyID+1,
6011 cd & ' msglen=',msglen,' nbytes=',nbytes
6012 cd write (iout,*) 'The received BUFFER array:'
6014 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6016 if (msglen.eq.msglen1) then
6017 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6018 else if (msglen.eq.msglen2) then
6019 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6020 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6023 & 'ERROR!!!! message length changed while processing correlations.'
6025 & 'ERROR!!!! message length changed while processing correlations.'
6026 call mp_stopall(Error)
6027 endif ! msglen.eq.msglen1
6028 endif ! MyRank.lt.fgProcs-1
6035 write (iout,'(a)') 'Contact function values:'
6037 write (iout,'(2i3,50(1x,i2,f5.2))')
6038 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6039 & j=1,num_cont_hb(i))
6045 C Remove the loop below after debugging !!!
6052 C Calculate the dipole-dipole interaction energies
6053 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6054 do i=iatel_s,iatel_e+1
6055 num_conti=num_cont_hb(i)
6062 C Calculate the local-electrostatic correlation terms
6063 do i=iatel_s,iatel_e+1
6065 num_conti=num_cont_hb(i)
6066 num_conti1=num_cont_hb(i+1)
6071 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6072 c & ' jj=',jj,' kk=',kk
6073 if (j1.eq.j+1 .or. j1.eq.j-1) then
6074 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6075 C The system gains extra energy.
6077 sqd1=dsqrt(d_cont(jj,i))
6078 sqd2=dsqrt(d_cont(kk,i1))
6079 sred_geom = sqd1*sqd2
6080 IF (sred_geom.lt.cutoff_corr) THEN
6081 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6083 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6084 c & ' jj=',jj,' kk=',kk
6085 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6086 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6088 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6089 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6092 cd write (iout,*) 'sred_geom=',sred_geom,
6093 cd & ' ekont=',ekont,' fprim=',fprimcont
6094 call calc_eello(i,j,i+1,j1,jj,kk)
6095 if (wcorr4.gt.0.0d0)
6096 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6097 if (wcorr5.gt.0.0d0)
6098 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6099 c print *,"wcorr5",ecorr5
6100 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6101 cd write(2,*)'ijkl',i,j,i+1,j1
6102 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6103 & .or. wturn6.eq.0.0d0))then
6104 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6105 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6106 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6107 cd & 'ecorr6=',ecorr6
6108 cd write (iout,'(4e15.5)') sred_geom,
6109 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6110 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6111 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6112 else if (wturn6.gt.0.0d0
6113 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6114 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6115 eturn6=eturn6+eello_turn6(i,jj,kk)
6116 cd write (2,*) 'multibody_eello:eturn6',eturn6
6117 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6124 else if (j1.eq.j) then
6125 C Contacts I-J and I-(J+1) occur simultaneously.
6126 C The system loses extra energy.
6127 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6132 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6133 c & ' jj=',jj,' kk=',kk
6135 C Contacts I-J and (I+1)-J occur simultaneously.
6136 C The system loses extra energy.
6137 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6142 write (iout,*) "eturn6",eturn6,ecorr6
6145 c------------------------------------------------------------------------------
6146 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6147 implicit real*8 (a-h,o-z)
6148 include 'DIMENSIONS'
6149 include 'COMMON.IOUNITS'
6150 include 'COMMON.DERIV'
6151 include 'COMMON.INTERACT'
6152 include 'COMMON.CONTACTS'
6153 include 'COMMON.CONTROL'
6154 include 'COMMON.SHIELD'
6155 double precision gx(3),gx1(3)
6165 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6166 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6167 C Following 4 lines for diagnostics.
6172 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6174 c write (iout,*)'Contacts have occurred for peptide groups',
6175 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6176 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6177 C Calculate the multi-body contribution to energy.
6178 C ecorr=ecorr+ekont*ees
6180 C Calculate multi-body contributions to the gradient.
6182 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6183 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6184 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6185 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6186 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6187 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6188 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6189 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6190 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6191 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6192 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6193 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6194 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6195 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6199 gradcorr(ll,m)=gradcorr(ll,m)+
6200 & ees*ekl*gacont_hbr(ll,jj,i)-
6201 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6202 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6207 gradcorr(ll,m)=gradcorr(ll,m)+
6208 & ees*eij*gacont_hbr(ll,kk,k)-
6209 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6210 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6213 if (shield_mode.gt.0) then
6216 C print *,i,j,fac_shield(i),fac_shield(j),
6217 C &fac_shield(k),fac_shield(l)
6218 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6219 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6220 do ilist=1,ishield_list(i)
6221 iresshield=shield_list(ilist,i)
6223 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6225 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6227 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6228 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6232 do ilist=1,ishield_list(j)
6233 iresshield=shield_list(ilist,j)
6235 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6237 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6239 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6240 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6244 do ilist=1,ishield_list(k)
6245 iresshield=shield_list(ilist,k)
6247 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6249 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6251 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6252 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6256 do ilist=1,ishield_list(l)
6257 iresshield=shield_list(ilist,l)
6259 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6261 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6263 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6264 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6268 C print *,gshieldx(m,iresshield)
6270 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6271 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6272 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6273 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6274 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6275 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6276 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6277 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6279 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6280 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6281 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6282 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6283 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6284 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6285 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6286 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6295 C---------------------------------------------------------------------------
6296 subroutine dipole(i,j,jj)
6297 implicit real*8 (a-h,o-z)
6298 include 'DIMENSIONS'
6299 include 'DIMENSIONS.ZSCOPT'
6300 include 'COMMON.IOUNITS'
6301 include 'COMMON.CHAIN'
6302 include 'COMMON.FFIELD'
6303 include 'COMMON.DERIV'
6304 include 'COMMON.INTERACT'
6305 include 'COMMON.CONTACTS'
6306 include 'COMMON.TORSION'
6307 include 'COMMON.VAR'
6308 include 'COMMON.GEO'
6309 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6311 iti1 = itortyp(itype(i+1))
6312 if (j.lt.nres-1) then
6313 if (itype(j).le.ntyp) then
6314 itj1 = itortyp(itype(j+1))
6322 dipi(iii,1)=Ub2(iii,i)
6323 dipderi(iii)=Ub2der(iii,i)
6324 dipi(iii,2)=b1(iii,iti1)
6325 dipj(iii,1)=Ub2(iii,j)
6326 dipderj(iii)=Ub2der(iii,j)
6327 dipj(iii,2)=b1(iii,itj1)
6331 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6334 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6337 if (.not.calc_grad) return
6342 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6346 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6351 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6352 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6354 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6356 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6358 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6362 C---------------------------------------------------------------------------
6363 subroutine calc_eello(i,j,k,l,jj,kk)
6365 C This subroutine computes matrices and vectors needed to calculate
6366 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6368 implicit real*8 (a-h,o-z)
6369 include 'DIMENSIONS'
6370 include 'DIMENSIONS.ZSCOPT'
6371 include 'COMMON.IOUNITS'
6372 include 'COMMON.CHAIN'
6373 include 'COMMON.DERIV'
6374 include 'COMMON.INTERACT'
6375 include 'COMMON.CONTACTS'
6376 include 'COMMON.TORSION'
6377 include 'COMMON.VAR'
6378 include 'COMMON.GEO'
6379 include 'COMMON.FFIELD'
6380 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6381 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6384 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6385 cd & ' jj=',jj,' kk=',kk
6386 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6389 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6390 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6393 call transpose2(aa1(1,1),aa1t(1,1))
6394 call transpose2(aa2(1,1),aa2t(1,1))
6397 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6398 & aa1tder(1,1,lll,kkk))
6399 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6400 & aa2tder(1,1,lll,kkk))
6404 C parallel orientation of the two CA-CA-CA frames.
6405 if (i.gt.1 .and. itype(i).le.ntyp) then
6406 iti=itortyp(itype(i))
6410 itk1=itortyp(itype(k+1))
6411 itj=itortyp(itype(j))
6412 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6413 itl1=itortyp(itype(l+1))
6417 C A1 kernel(j+1) A2T
6419 cd write (iout,'(3f10.5,5x,3f10.5)')
6420 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6422 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6423 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6424 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6425 C Following matrices are needed only for 6-th order cumulants
6426 IF (wcorr6.gt.0.0d0) THEN
6427 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6428 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6429 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6430 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6431 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6432 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6433 & ADtEAderx(1,1,1,1,1,1))
6435 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6436 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6437 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6438 & ADtEA1derx(1,1,1,1,1,1))
6440 C End 6-th order cumulants
6443 cd write (2,*) 'In calc_eello6'
6445 cd write (2,*) 'iii=',iii
6447 cd write (2,*) 'kkk=',kkk
6449 cd write (2,'(3(2f10.5),5x)')
6450 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6455 call transpose2(EUgder(1,1,k),auxmat(1,1))
6456 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6457 call transpose2(EUg(1,1,k),auxmat(1,1))
6458 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6459 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6463 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6464 & EAEAderx(1,1,lll,kkk,iii,1))
6468 C A1T kernel(i+1) A2
6469 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6470 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6471 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6472 C Following matrices are needed only for 6-th order cumulants
6473 IF (wcorr6.gt.0.0d0) THEN
6474 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6475 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6476 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6477 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6478 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6479 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6480 & ADtEAderx(1,1,1,1,1,2))
6481 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6482 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6483 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6484 & ADtEA1derx(1,1,1,1,1,2))
6486 C End 6-th order cumulants
6487 call transpose2(EUgder(1,1,l),auxmat(1,1))
6488 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6489 call transpose2(EUg(1,1,l),auxmat(1,1))
6490 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6491 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6495 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6496 & EAEAderx(1,1,lll,kkk,iii,2))
6501 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6502 C They are needed only when the fifth- or the sixth-order cumulants are
6504 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6505 call transpose2(AEA(1,1,1),auxmat(1,1))
6506 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6507 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6508 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6509 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6510 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6511 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6512 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6513 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6514 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6515 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6516 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6517 call transpose2(AEA(1,1,2),auxmat(1,1))
6518 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6519 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6520 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6521 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6522 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6523 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6524 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6525 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6526 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6527 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6528 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6529 C Calculate the Cartesian derivatives of the vectors.
6533 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6534 call matvec2(auxmat(1,1),b1(1,iti),
6535 & AEAb1derx(1,lll,kkk,iii,1,1))
6536 call matvec2(auxmat(1,1),Ub2(1,i),
6537 & AEAb2derx(1,lll,kkk,iii,1,1))
6538 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6539 & AEAb1derx(1,lll,kkk,iii,2,1))
6540 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6541 & AEAb2derx(1,lll,kkk,iii,2,1))
6542 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6543 call matvec2(auxmat(1,1),b1(1,itj),
6544 & AEAb1derx(1,lll,kkk,iii,1,2))
6545 call matvec2(auxmat(1,1),Ub2(1,j),
6546 & AEAb2derx(1,lll,kkk,iii,1,2))
6547 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6548 & AEAb1derx(1,lll,kkk,iii,2,2))
6549 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6550 & AEAb2derx(1,lll,kkk,iii,2,2))
6557 C Antiparallel orientation of the two CA-CA-CA frames.
6558 if (i.gt.1 .and. itype(i).le.ntyp) then
6559 iti=itortyp(itype(i))
6563 itk1=itortyp(itype(k+1))
6564 itl=itortyp(itype(l))
6565 itj=itortyp(itype(j))
6566 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6567 itj1=itortyp(itype(j+1))
6571 C A2 kernel(j-1)T A1T
6572 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6573 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6574 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6575 C Following matrices are needed only for 6-th order cumulants
6576 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6577 & j.eq.i+4 .and. l.eq.i+3)) THEN
6578 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6579 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6580 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6581 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6582 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6583 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6584 & ADtEAderx(1,1,1,1,1,1))
6585 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6586 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6587 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6588 & ADtEA1derx(1,1,1,1,1,1))
6590 C End 6-th order cumulants
6591 call transpose2(EUgder(1,1,k),auxmat(1,1))
6592 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6593 call transpose2(EUg(1,1,k),auxmat(1,1))
6594 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6595 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6599 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6600 & EAEAderx(1,1,lll,kkk,iii,1))
6604 C A2T kernel(i+1)T A1
6605 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6606 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6607 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6608 C Following matrices are needed only for 6-th order cumulants
6609 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6610 & j.eq.i+4 .and. l.eq.i+3)) THEN
6611 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6612 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6613 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6614 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6615 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6616 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6617 & ADtEAderx(1,1,1,1,1,2))
6618 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6619 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6620 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6621 & ADtEA1derx(1,1,1,1,1,2))
6623 C End 6-th order cumulants
6624 call transpose2(EUgder(1,1,j),auxmat(1,1))
6625 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6626 call transpose2(EUg(1,1,j),auxmat(1,1))
6627 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6628 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6632 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6633 & EAEAderx(1,1,lll,kkk,iii,2))
6638 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6639 C They are needed only when the fifth- or the sixth-order cumulants are
6641 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6642 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6643 call transpose2(AEA(1,1,1),auxmat(1,1))
6644 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6645 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6646 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6647 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6648 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6649 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6650 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6651 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6652 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6653 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6654 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6655 call transpose2(AEA(1,1,2),auxmat(1,1))
6656 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6657 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6658 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6659 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6660 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6661 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6662 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6663 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6664 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6665 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6666 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6667 C Calculate the Cartesian derivatives of the vectors.
6671 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6672 call matvec2(auxmat(1,1),b1(1,iti),
6673 & AEAb1derx(1,lll,kkk,iii,1,1))
6674 call matvec2(auxmat(1,1),Ub2(1,i),
6675 & AEAb2derx(1,lll,kkk,iii,1,1))
6676 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6677 & AEAb1derx(1,lll,kkk,iii,2,1))
6678 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6679 & AEAb2derx(1,lll,kkk,iii,2,1))
6680 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6681 call matvec2(auxmat(1,1),b1(1,itl),
6682 & AEAb1derx(1,lll,kkk,iii,1,2))
6683 call matvec2(auxmat(1,1),Ub2(1,l),
6684 & AEAb2derx(1,lll,kkk,iii,1,2))
6685 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6686 & AEAb1derx(1,lll,kkk,iii,2,2))
6687 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6688 & AEAb2derx(1,lll,kkk,iii,2,2))
6697 C---------------------------------------------------------------------------
6698 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6699 & KK,KKderg,AKA,AKAderg,AKAderx)
6703 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6704 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6705 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6710 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6712 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6715 cd if (lprn) write (2,*) 'In kernel'
6717 cd if (lprn) write (2,*) 'kkk=',kkk
6719 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6720 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6722 cd write (2,*) 'lll=',lll
6723 cd write (2,*) 'iii=1'
6725 cd write (2,'(3(2f10.5),5x)')
6726 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6729 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6730 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6732 cd write (2,*) 'lll=',lll
6733 cd write (2,*) 'iii=2'
6735 cd write (2,'(3(2f10.5),5x)')
6736 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6743 C---------------------------------------------------------------------------
6744 double precision function eello4(i,j,k,l,jj,kk)
6745 implicit real*8 (a-h,o-z)
6746 include 'DIMENSIONS'
6747 include 'DIMENSIONS.ZSCOPT'
6748 include 'COMMON.IOUNITS'
6749 include 'COMMON.CHAIN'
6750 include 'COMMON.DERIV'
6751 include 'COMMON.INTERACT'
6752 include 'COMMON.CONTACTS'
6753 include 'COMMON.TORSION'
6754 include 'COMMON.VAR'
6755 include 'COMMON.GEO'
6756 double precision pizda(2,2),ggg1(3),ggg2(3)
6757 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6761 cd print *,'eello4:',i,j,k,l,jj,kk
6762 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6763 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6764 cold eij=facont_hb(jj,i)
6765 cold ekl=facont_hb(kk,k)
6767 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6769 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6770 gcorr_loc(k-1)=gcorr_loc(k-1)
6771 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6773 gcorr_loc(l-1)=gcorr_loc(l-1)
6774 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6776 gcorr_loc(j-1)=gcorr_loc(j-1)
6777 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6782 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6783 & -EAEAderx(2,2,lll,kkk,iii,1)
6784 cd derx(lll,kkk,iii)=0.0d0
6788 cd gcorr_loc(l-1)=0.0d0
6789 cd gcorr_loc(j-1)=0.0d0
6790 cd gcorr_loc(k-1)=0.0d0
6792 cd write (iout,*)'Contacts have occurred for peptide groups',
6793 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6794 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6795 if (j.lt.nres-1) then
6802 if (l.lt.nres-1) then
6810 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6811 ggg1(ll)=eel4*g_contij(ll,1)
6812 ggg2(ll)=eel4*g_contij(ll,2)
6813 ghalf=0.5d0*ggg1(ll)
6815 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6816 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6817 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6818 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6819 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6820 ghalf=0.5d0*ggg2(ll)
6822 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6823 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6824 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6825 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6830 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6831 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6836 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6837 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6843 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6848 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6852 cd write (2,*) iii,gcorr_loc(iii)
6856 cd write (2,*) 'ekont',ekont
6857 cd write (iout,*) 'eello4',ekont*eel4
6860 C---------------------------------------------------------------------------
6861 double precision function eello5(i,j,k,l,jj,kk)
6862 implicit real*8 (a-h,o-z)
6863 include 'DIMENSIONS'
6864 include 'DIMENSIONS.ZSCOPT'
6865 include 'COMMON.IOUNITS'
6866 include 'COMMON.CHAIN'
6867 include 'COMMON.DERIV'
6868 include 'COMMON.INTERACT'
6869 include 'COMMON.CONTACTS'
6870 include 'COMMON.TORSION'
6871 include 'COMMON.VAR'
6872 include 'COMMON.GEO'
6873 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6874 double precision ggg1(3),ggg2(3)
6875 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6880 C /l\ / \ \ / \ / \ / C
6881 C / \ / \ \ / \ / \ / C
6882 C j| o |l1 | o | o| o | | o |o C
6883 C \ |/k\| |/ \| / |/ \| |/ \| C
6884 C \i/ \ / \ / / \ / \ C
6886 C (I) (II) (III) (IV) C
6888 C eello5_1 eello5_2 eello5_3 eello5_4 C
6890 C Antiparallel chains C
6893 C /j\ / \ \ / \ / \ / C
6894 C / \ / \ \ / \ / \ / C
6895 C j1| o |l | o | o| o | | o |o C
6896 C \ |/k\| |/ \| / |/ \| |/ \| C
6897 C \i/ \ / \ / / \ / \ C
6899 C (I) (II) (III) (IV) C
6901 C eello5_1 eello5_2 eello5_3 eello5_4 C
6903 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6905 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6906 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6911 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6913 itk=itortyp(itype(k))
6914 itl=itortyp(itype(l))
6915 itj=itortyp(itype(j))
6920 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6921 cd & eel5_3_num,eel5_4_num)
6925 derx(lll,kkk,iii)=0.0d0
6929 cd eij=facont_hb(jj,i)
6930 cd ekl=facont_hb(kk,k)
6932 cd write (iout,*)'Contacts have occurred for peptide groups',
6933 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6935 C Contribution from the graph I.
6936 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6937 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6938 call transpose2(EUg(1,1,k),auxmat(1,1))
6939 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6940 vv(1)=pizda(1,1)-pizda(2,2)
6941 vv(2)=pizda(1,2)+pizda(2,1)
6942 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6943 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6945 C Explicit gradient in virtual-dihedral angles.
6946 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6947 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6948 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6949 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6950 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6951 vv(1)=pizda(1,1)-pizda(2,2)
6952 vv(2)=pizda(1,2)+pizda(2,1)
6953 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6954 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6955 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6956 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6957 vv(1)=pizda(1,1)-pizda(2,2)
6958 vv(2)=pizda(1,2)+pizda(2,1)
6960 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6961 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6962 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6964 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6965 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6966 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6968 C Cartesian gradient
6972 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6974 vv(1)=pizda(1,1)-pizda(2,2)
6975 vv(2)=pizda(1,2)+pizda(2,1)
6976 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6977 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6978 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6985 C Contribution from graph II
6986 call transpose2(EE(1,1,itk),auxmat(1,1))
6987 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6988 vv(1)=pizda(1,1)+pizda(2,2)
6989 vv(2)=pizda(2,1)-pizda(1,2)
6990 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6991 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6993 C Explicit gradient in virtual-dihedral angles.
6994 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6995 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6996 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6997 vv(1)=pizda(1,1)+pizda(2,2)
6998 vv(2)=pizda(2,1)-pizda(1,2)
7000 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7001 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7002 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7004 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7005 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7006 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7008 C Cartesian gradient
7012 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7014 vv(1)=pizda(1,1)+pizda(2,2)
7015 vv(2)=pizda(2,1)-pizda(1,2)
7016 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7017 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7018 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7027 C Parallel orientation
7028 C Contribution from graph III
7029 call transpose2(EUg(1,1,l),auxmat(1,1))
7030 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7031 vv(1)=pizda(1,1)-pizda(2,2)
7032 vv(2)=pizda(1,2)+pizda(2,1)
7033 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7034 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7036 C Explicit gradient in virtual-dihedral angles.
7037 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7038 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7039 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7040 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7041 vv(1)=pizda(1,1)-pizda(2,2)
7042 vv(2)=pizda(1,2)+pizda(2,1)
7043 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7044 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7045 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7046 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7047 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7048 vv(1)=pizda(1,1)-pizda(2,2)
7049 vv(2)=pizda(1,2)+pizda(2,1)
7050 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7051 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7052 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7053 C Cartesian gradient
7057 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7059 vv(1)=pizda(1,1)-pizda(2,2)
7060 vv(2)=pizda(1,2)+pizda(2,1)
7061 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7062 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7063 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7069 C Contribution from graph IV
7071 call transpose2(EE(1,1,itl),auxmat(1,1))
7072 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7073 vv(1)=pizda(1,1)+pizda(2,2)
7074 vv(2)=pizda(2,1)-pizda(1,2)
7075 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7076 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7078 C Explicit gradient in virtual-dihedral angles.
7079 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7080 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7081 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7082 vv(1)=pizda(1,1)+pizda(2,2)
7083 vv(2)=pizda(2,1)-pizda(1,2)
7084 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7085 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7086 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7087 C Cartesian gradient
7091 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7093 vv(1)=pizda(1,1)+pizda(2,2)
7094 vv(2)=pizda(2,1)-pizda(1,2)
7095 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7096 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7097 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7103 C Antiparallel orientation
7104 C Contribution from graph III
7106 call transpose2(EUg(1,1,j),auxmat(1,1))
7107 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7108 vv(1)=pizda(1,1)-pizda(2,2)
7109 vv(2)=pizda(1,2)+pizda(2,1)
7110 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7111 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7113 C Explicit gradient in virtual-dihedral angles.
7114 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7115 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7116 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7117 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7118 vv(1)=pizda(1,1)-pizda(2,2)
7119 vv(2)=pizda(1,2)+pizda(2,1)
7120 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7121 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7122 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7123 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7124 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7125 vv(1)=pizda(1,1)-pizda(2,2)
7126 vv(2)=pizda(1,2)+pizda(2,1)
7127 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7128 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7129 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7130 C Cartesian gradient
7134 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7136 vv(1)=pizda(1,1)-pizda(2,2)
7137 vv(2)=pizda(1,2)+pizda(2,1)
7138 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7139 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7140 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7146 C Contribution from graph IV
7148 call transpose2(EE(1,1,itj),auxmat(1,1))
7149 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7150 vv(1)=pizda(1,1)+pizda(2,2)
7151 vv(2)=pizda(2,1)-pizda(1,2)
7152 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7153 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7155 C Explicit gradient in virtual-dihedral angles.
7156 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7157 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7158 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7159 vv(1)=pizda(1,1)+pizda(2,2)
7160 vv(2)=pizda(2,1)-pizda(1,2)
7161 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7162 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7163 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7164 C Cartesian gradient
7168 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7170 vv(1)=pizda(1,1)+pizda(2,2)
7171 vv(2)=pizda(2,1)-pizda(1,2)
7172 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7173 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7174 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7181 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7182 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7183 cd write (2,*) 'ijkl',i,j,k,l
7184 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7185 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7187 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7188 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7189 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7190 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7192 if (j.lt.nres-1) then
7199 if (l.lt.nres-1) then
7209 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7211 ggg1(ll)=eel5*g_contij(ll,1)
7212 ggg2(ll)=eel5*g_contij(ll,2)
7213 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7214 ghalf=0.5d0*ggg1(ll)
7216 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7217 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7218 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7219 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7220 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7221 ghalf=0.5d0*ggg2(ll)
7223 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7224 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7225 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7226 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7231 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7232 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7237 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7238 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7244 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7249 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7253 cd write (2,*) iii,g_corr5_loc(iii)
7257 cd write (2,*) 'ekont',ekont
7258 cd write (iout,*) 'eello5',ekont*eel5
7261 c--------------------------------------------------------------------------
7262 double precision function eello6(i,j,k,l,jj,kk)
7263 implicit real*8 (a-h,o-z)
7264 include 'DIMENSIONS'
7265 include 'DIMENSIONS.ZSCOPT'
7266 include 'COMMON.IOUNITS'
7267 include 'COMMON.CHAIN'
7268 include 'COMMON.DERIV'
7269 include 'COMMON.INTERACT'
7270 include 'COMMON.CONTACTS'
7271 include 'COMMON.TORSION'
7272 include 'COMMON.VAR'
7273 include 'COMMON.GEO'
7274 include 'COMMON.FFIELD'
7275 double precision ggg1(3),ggg2(3)
7276 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7281 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7289 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7290 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7294 derx(lll,kkk,iii)=0.0d0
7298 cd eij=facont_hb(jj,i)
7299 cd ekl=facont_hb(kk,k)
7305 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7306 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7307 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7308 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7309 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7310 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7312 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7313 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7314 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7315 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7316 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7317 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7321 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7323 C If turn contributions are considered, they will be handled separately.
7324 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7325 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7326 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7327 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7328 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7329 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7330 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7333 if (j.lt.nres-1) then
7340 if (l.lt.nres-1) then
7348 ggg1(ll)=eel6*g_contij(ll,1)
7349 ggg2(ll)=eel6*g_contij(ll,2)
7350 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7351 ghalf=0.5d0*ggg1(ll)
7353 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7354 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7355 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7356 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7357 ghalf=0.5d0*ggg2(ll)
7358 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7360 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7361 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7362 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7363 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7368 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7369 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7374 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7375 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7381 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7386 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7390 cd write (2,*) iii,g_corr6_loc(iii)
7394 cd write (2,*) 'ekont',ekont
7395 cd write (iout,*) 'eello6',ekont*eel6
7398 c--------------------------------------------------------------------------
7399 double precision function eello6_graph1(i,j,k,l,imat,swap)
7400 implicit real*8 (a-h,o-z)
7401 include 'DIMENSIONS'
7402 include 'DIMENSIONS.ZSCOPT'
7403 include 'COMMON.IOUNITS'
7404 include 'COMMON.CHAIN'
7405 include 'COMMON.DERIV'
7406 include 'COMMON.INTERACT'
7407 include 'COMMON.CONTACTS'
7408 include 'COMMON.TORSION'
7409 include 'COMMON.VAR'
7410 include 'COMMON.GEO'
7411 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7415 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7417 C Parallel Antiparallel C
7423 C \ j|/k\| / \ |/k\|l / C
7428 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7429 itk=itortyp(itype(k))
7430 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7431 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7432 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7433 call transpose2(EUgC(1,1,k),auxmat(1,1))
7434 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7435 vv1(1)=pizda1(1,1)-pizda1(2,2)
7436 vv1(2)=pizda1(1,2)+pizda1(2,1)
7437 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7438 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7439 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7440 s5=scalar2(vv(1),Dtobr2(1,i))
7441 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7442 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7443 if (.not. calc_grad) return
7444 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7445 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7446 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7447 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7448 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7449 & +scalar2(vv(1),Dtobr2der(1,i)))
7450 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7451 vv1(1)=pizda1(1,1)-pizda1(2,2)
7452 vv1(2)=pizda1(1,2)+pizda1(2,1)
7453 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7454 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7456 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7457 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7458 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7459 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7460 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7462 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7463 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7464 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7465 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7466 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7468 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7469 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7470 vv1(1)=pizda1(1,1)-pizda1(2,2)
7471 vv1(2)=pizda1(1,2)+pizda1(2,1)
7472 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7473 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7474 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7475 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7484 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7485 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7486 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7487 call transpose2(EUgC(1,1,k),auxmat(1,1))
7488 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7490 vv1(1)=pizda1(1,1)-pizda1(2,2)
7491 vv1(2)=pizda1(1,2)+pizda1(2,1)
7492 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7493 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7494 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7495 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7496 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7497 s5=scalar2(vv(1),Dtobr2(1,i))
7498 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7504 c----------------------------------------------------------------------------
7505 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7506 implicit real*8 (a-h,o-z)
7507 include 'DIMENSIONS'
7508 include 'DIMENSIONS.ZSCOPT'
7509 include 'COMMON.IOUNITS'
7510 include 'COMMON.CHAIN'
7511 include 'COMMON.DERIV'
7512 include 'COMMON.INTERACT'
7513 include 'COMMON.CONTACTS'
7514 include 'COMMON.TORSION'
7515 include 'COMMON.VAR'
7516 include 'COMMON.GEO'
7518 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7519 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7522 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7524 C Parallel Antiparallel C
7530 C \ j|/k\| \ |/k\|l C
7535 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7536 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7537 C AL 7/4/01 s1 would occur in the sixth-order moment,
7538 C but not in a cluster cumulant
7540 s1=dip(1,jj,i)*dip(1,kk,k)
7542 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7543 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7544 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7545 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7546 call transpose2(EUg(1,1,k),auxmat(1,1))
7547 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7548 vv(1)=pizda(1,1)-pizda(2,2)
7549 vv(2)=pizda(1,2)+pizda(2,1)
7550 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7551 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7553 eello6_graph2=-(s1+s2+s3+s4)
7555 eello6_graph2=-(s2+s3+s4)
7558 if (.not. calc_grad) return
7559 C Derivatives in gamma(i-1)
7562 s1=dipderg(1,jj,i)*dip(1,kk,k)
7564 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7565 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7566 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7567 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7569 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7571 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7573 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7575 C Derivatives in gamma(k-1)
7577 s1=dip(1,jj,i)*dipderg(1,kk,k)
7579 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7580 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7581 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7582 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7583 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7584 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7585 vv(1)=pizda(1,1)-pizda(2,2)
7586 vv(2)=pizda(1,2)+pizda(2,1)
7587 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7589 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7591 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7593 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7594 C Derivatives in gamma(j-1) or gamma(l-1)
7597 s1=dipderg(3,jj,i)*dip(1,kk,k)
7599 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7600 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7601 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7602 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7603 vv(1)=pizda(1,1)-pizda(2,2)
7604 vv(2)=pizda(1,2)+pizda(2,1)
7605 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7608 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7610 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7613 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7614 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7616 C Derivatives in gamma(l-1) or gamma(j-1)
7619 s1=dip(1,jj,i)*dipderg(3,kk,k)
7621 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7622 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7623 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7624 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7625 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7626 vv(1)=pizda(1,1)-pizda(2,2)
7627 vv(2)=pizda(1,2)+pizda(2,1)
7628 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7631 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7633 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7636 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7637 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7639 C Cartesian derivatives.
7641 write (2,*) 'In eello6_graph2'
7643 write (2,*) 'iii=',iii
7645 write (2,*) 'kkk=',kkk
7647 write (2,'(3(2f10.5),5x)')
7648 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7658 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7660 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7663 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7665 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7666 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7668 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7669 call transpose2(EUg(1,1,k),auxmat(1,1))
7670 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7672 vv(1)=pizda(1,1)-pizda(2,2)
7673 vv(2)=pizda(1,2)+pizda(2,1)
7674 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7675 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7677 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7679 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7682 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7684 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7691 c----------------------------------------------------------------------------
7692 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7693 implicit real*8 (a-h,o-z)
7694 include 'DIMENSIONS'
7695 include 'DIMENSIONS.ZSCOPT'
7696 include 'COMMON.IOUNITS'
7697 include 'COMMON.CHAIN'
7698 include 'COMMON.DERIV'
7699 include 'COMMON.INTERACT'
7700 include 'COMMON.CONTACTS'
7701 include 'COMMON.TORSION'
7702 include 'COMMON.VAR'
7703 include 'COMMON.GEO'
7704 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7706 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7708 C Parallel Antiparallel C
7714 C j|/k\| / |/k\|l / C
7719 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7721 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7722 C energy moment and not to the cluster cumulant.
7723 iti=itortyp(itype(i))
7724 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7725 itj1=itortyp(itype(j+1))
7729 itk=itortyp(itype(k))
7730 itk1=itortyp(itype(k+1))
7731 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7732 itl1=itortyp(itype(l+1))
7737 s1=dip(4,jj,i)*dip(4,kk,k)
7739 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7740 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7741 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7742 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7743 call transpose2(EE(1,1,itk),auxmat(1,1))
7744 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7745 vv(1)=pizda(1,1)+pizda(2,2)
7746 vv(2)=pizda(2,1)-pizda(1,2)
7747 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7748 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7750 eello6_graph3=-(s1+s2+s3+s4)
7752 eello6_graph3=-(s2+s3+s4)
7755 if (.not. calc_grad) return
7756 C Derivatives in gamma(k-1)
7757 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7758 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7759 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7760 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7761 C Derivatives in gamma(l-1)
7762 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7763 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7764 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7765 vv(1)=pizda(1,1)+pizda(2,2)
7766 vv(2)=pizda(2,1)-pizda(1,2)
7767 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7768 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7769 C Cartesian derivatives.
7775 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7777 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7780 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7782 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7783 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7785 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7786 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7788 vv(1)=pizda(1,1)+pizda(2,2)
7789 vv(2)=pizda(2,1)-pizda(1,2)
7790 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7792 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7794 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7797 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7799 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7801 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7807 c----------------------------------------------------------------------------
7808 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7809 implicit real*8 (a-h,o-z)
7810 include 'DIMENSIONS'
7811 include 'DIMENSIONS.ZSCOPT'
7812 include 'COMMON.IOUNITS'
7813 include 'COMMON.CHAIN'
7814 include 'COMMON.DERIV'
7815 include 'COMMON.INTERACT'
7816 include 'COMMON.CONTACTS'
7817 include 'COMMON.TORSION'
7818 include 'COMMON.VAR'
7819 include 'COMMON.GEO'
7820 include 'COMMON.FFIELD'
7821 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7822 & auxvec1(2),auxmat1(2,2)
7824 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7826 C Parallel Antiparallel C
7832 C \ j|/k\| \ |/k\|l C
7837 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7839 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7840 C energy moment and not to the cluster cumulant.
7841 cd write (2,*) 'eello_graph4: wturn6',wturn6
7842 iti=itortyp(itype(i))
7843 itj=itortyp(itype(j))
7844 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7845 itj1=itortyp(itype(j+1))
7849 itk=itortyp(itype(k))
7850 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7851 itk1=itortyp(itype(k+1))
7855 itl=itortyp(itype(l))
7856 if (l.lt.nres-1) then
7857 itl1=itortyp(itype(l+1))
7861 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7862 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7863 cd & ' itl',itl,' itl1',itl1
7866 s1=dip(3,jj,i)*dip(3,kk,k)
7868 s1=dip(2,jj,j)*dip(2,kk,l)
7871 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7872 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7874 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7875 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7877 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7878 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7880 call transpose2(EUg(1,1,k),auxmat(1,1))
7881 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7882 vv(1)=pizda(1,1)-pizda(2,2)
7883 vv(2)=pizda(2,1)+pizda(1,2)
7884 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7885 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7887 eello6_graph4=-(s1+s2+s3+s4)
7889 eello6_graph4=-(s2+s3+s4)
7891 if (.not. calc_grad) return
7892 C Derivatives in gamma(i-1)
7896 s1=dipderg(2,jj,i)*dip(3,kk,k)
7898 s1=dipderg(4,jj,j)*dip(2,kk,l)
7901 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7903 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7904 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7906 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7907 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7909 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7910 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7911 cd write (2,*) 'turn6 derivatives'
7913 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7915 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7919 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7921 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7925 C Derivatives in gamma(k-1)
7928 s1=dip(3,jj,i)*dipderg(2,kk,k)
7930 s1=dip(2,jj,j)*dipderg(4,kk,l)
7933 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7934 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7936 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7937 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7939 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7940 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7942 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7943 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7944 vv(1)=pizda(1,1)-pizda(2,2)
7945 vv(2)=pizda(2,1)+pizda(1,2)
7946 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7947 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7949 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7951 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7955 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7957 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7960 C Derivatives in gamma(j-1) or gamma(l-1)
7961 if (l.eq.j+1 .and. l.gt.1) then
7962 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7963 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7964 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7965 vv(1)=pizda(1,1)-pizda(2,2)
7966 vv(2)=pizda(2,1)+pizda(1,2)
7967 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7968 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7969 else if (j.gt.1) then
7970 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7971 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7972 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7973 vv(1)=pizda(1,1)-pizda(2,2)
7974 vv(2)=pizda(2,1)+pizda(1,2)
7975 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7976 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7977 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7979 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7982 C Cartesian derivatives.
7989 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7991 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7995 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7997 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8001 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8003 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8005 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8006 & b1(1,itj1),auxvec(1))
8007 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8009 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8010 & b1(1,itl1),auxvec(1))
8011 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8013 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8015 vv(1)=pizda(1,1)-pizda(2,2)
8016 vv(2)=pizda(2,1)+pizda(1,2)
8017 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8019 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8021 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8024 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8027 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8030 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8032 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8034 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8038 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8040 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8043 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8045 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8053 c----------------------------------------------------------------------------
8054 double precision function eello_turn6(i,jj,kk)
8055 implicit real*8 (a-h,o-z)
8056 include 'DIMENSIONS'
8057 include 'DIMENSIONS.ZSCOPT'
8058 include 'COMMON.IOUNITS'
8059 include 'COMMON.CHAIN'
8060 include 'COMMON.DERIV'
8061 include 'COMMON.INTERACT'
8062 include 'COMMON.CONTACTS'
8063 include 'COMMON.TORSION'
8064 include 'COMMON.VAR'
8065 include 'COMMON.GEO'
8066 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8067 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8069 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8070 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8071 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8072 C the respective energy moment and not to the cluster cumulant.
8077 iti=itortyp(itype(i))
8078 itk=itortyp(itype(k))
8079 itk1=itortyp(itype(k+1))
8080 itl=itortyp(itype(l))
8081 itj=itortyp(itype(j))
8082 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8083 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8084 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8089 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8091 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8095 derx_turn(lll,kkk,iii)=0.0d0
8102 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8104 cd write (2,*) 'eello6_5',eello6_5
8106 call transpose2(AEA(1,1,1),auxmat(1,1))
8107 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8108 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8109 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8113 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8114 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8115 s2 = scalar2(b1(1,itk),vtemp1(1))
8117 call transpose2(AEA(1,1,2),atemp(1,1))
8118 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8119 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8120 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8124 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8125 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8126 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8128 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8129 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8130 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8131 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8132 ss13 = scalar2(b1(1,itk),vtemp4(1))
8133 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8137 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8143 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8145 C Derivatives in gamma(i+2)
8147 call transpose2(AEA(1,1,1),auxmatd(1,1))
8148 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8149 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8150 call transpose2(AEAderg(1,1,2),atempd(1,1))
8151 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8152 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8156 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8157 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8158 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8164 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8165 C Derivatives in gamma(i+3)
8167 call transpose2(AEA(1,1,1),auxmatd(1,1))
8168 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8169 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8170 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8174 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8175 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8176 s2d = scalar2(b1(1,itk),vtemp1d(1))
8178 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8179 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8181 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8183 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8184 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8185 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8195 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8196 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8198 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8199 & -0.5d0*ekont*(s2d+s12d)
8201 C Derivatives in gamma(i+4)
8202 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8203 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8204 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8206 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8207 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8208 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8218 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8220 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8222 C Derivatives in gamma(i+5)
8224 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8225 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8226 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8230 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8231 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8232 s2d = scalar2(b1(1,itk),vtemp1d(1))
8234 call transpose2(AEA(1,1,2),atempd(1,1))
8235 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8236 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8240 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8241 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8243 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8244 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8245 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8255 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8256 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8258 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8259 & -0.5d0*ekont*(s2d+s12d)
8261 C Cartesian derivatives
8266 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8267 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8268 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8272 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8273 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8275 s2d = scalar2(b1(1,itk),vtemp1d(1))
8277 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8278 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8279 s8d = -(atempd(1,1)+atempd(2,2))*
8280 & scalar2(cc(1,1,itl),vtemp2(1))
8284 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8286 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8287 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8294 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8297 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8301 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8302 & - 0.5d0*(s8d+s12d)
8304 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8313 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8315 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8316 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8317 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8318 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8319 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8321 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8322 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8323 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8327 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8328 cd & 16*eel_turn6_num
8330 if (j.lt.nres-1) then
8337 if (l.lt.nres-1) then
8345 ggg1(ll)=eel_turn6*g_contij(ll,1)
8346 ggg2(ll)=eel_turn6*g_contij(ll,2)
8347 ghalf=0.5d0*ggg1(ll)
8349 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8350 & +ekont*derx_turn(ll,2,1)
8351 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8352 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8353 & +ekont*derx_turn(ll,4,1)
8354 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8355 ghalf=0.5d0*ggg2(ll)
8357 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8358 & +ekont*derx_turn(ll,2,2)
8359 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8360 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8361 & +ekont*derx_turn(ll,4,2)
8362 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8367 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8372 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8378 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8383 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8387 cd write (2,*) iii,g_corr6_loc(iii)
8390 eello_turn6=ekont*eel_turn6
8391 cd write (2,*) 'ekont',ekont
8392 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8395 crc-------------------------------------------------
8396 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8397 subroutine Eliptransfer(eliptran)
8398 implicit real*8 (a-h,o-z)
8399 include 'DIMENSIONS'
8400 include 'COMMON.GEO'
8401 include 'COMMON.VAR'
8402 include 'COMMON.LOCAL'
8403 include 'COMMON.CHAIN'
8404 include 'COMMON.DERIV'
8405 include 'COMMON.INTERACT'
8406 include 'COMMON.IOUNITS'
8407 include 'COMMON.CALC'
8408 include 'COMMON.CONTROL'
8409 include 'COMMON.SPLITELE'
8410 include 'COMMON.SBRIDGE'
8411 C this is done by Adasko
8415 C--bordliptop-- buffore starts
8416 C--bufliptop--- here true lipid starts
8418 C--buflipbot--- lipid ends buffore starts
8419 C--bordlipbot--buffore ends
8423 if (itype(i).eq.ntyp1) cycle
8425 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8426 if (positi.le.0) positi=positi+boxzsize
8428 C first for peptide groups
8429 c for each residue check if it is in lipid or lipid water border area
8430 if ((positi.gt.bordlipbot)
8431 &.and.(positi.lt.bordliptop)) then
8432 C the energy transfer exist
8433 if (positi.lt.buflipbot) then
8434 C what fraction I am in
8436 & ((positi-bordlipbot)/lipbufthick)
8437 C lipbufthick is thickenes of lipid buffore
8438 sslip=sscalelip(fracinbuf)
8439 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8440 eliptran=eliptran+sslip*pepliptran
8441 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8442 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8443 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8444 elseif (positi.gt.bufliptop) then
8445 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8446 sslip=sscalelip(fracinbuf)
8447 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8448 eliptran=eliptran+sslip*pepliptran
8449 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8450 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8451 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8452 C print *, "doing sscalefor top part"
8453 C print *,i,sslip,fracinbuf,ssgradlip
8455 eliptran=eliptran+pepliptran
8456 C print *,"I am in true lipid"
8459 C eliptran=elpitran+0.0 ! I am in water
8462 C print *, "nic nie bylo w lipidzie?"
8463 C now multiply all by the peptide group transfer factor
8464 C eliptran=eliptran*pepliptran
8465 C now the same for side chains
8468 if (itype(i).eq.ntyp1) cycle
8469 positi=(mod(c(3,i+nres),boxzsize))
8470 if (positi.le.0) positi=positi+boxzsize
8471 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8472 c for each residue check if it is in lipid or lipid water border area
8473 C respos=mod(c(3,i+nres),boxzsize)
8474 C print *,positi,bordlipbot,buflipbot
8475 if ((positi.gt.bordlipbot)
8476 & .and.(positi.lt.bordliptop)) then
8477 C the energy transfer exist
8478 if (positi.lt.buflipbot) then
8480 & ((positi-bordlipbot)/lipbufthick)
8481 C lipbufthick is thickenes of lipid buffore
8482 sslip=sscalelip(fracinbuf)
8483 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8484 eliptran=eliptran+sslip*liptranene(itype(i))
8485 gliptranx(3,i)=gliptranx(3,i)
8486 &+ssgradlip*liptranene(itype(i))
8487 gliptranc(3,i-1)= gliptranc(3,i-1)
8488 &+ssgradlip*liptranene(itype(i))
8489 C print *,"doing sccale for lower part"
8490 elseif (positi.gt.bufliptop) then
8492 &((bordliptop-positi)/lipbufthick)
8493 sslip=sscalelip(fracinbuf)
8494 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8495 eliptran=eliptran+sslip*liptranene(itype(i))
8496 gliptranx(3,i)=gliptranx(3,i)
8497 &+ssgradlip*liptranene(itype(i))
8498 gliptranc(3,i-1)= gliptranc(3,i-1)
8499 &+ssgradlip*liptranene(itype(i))
8500 C print *, "doing sscalefor top part",sslip,fracinbuf
8502 eliptran=eliptran+liptranene(itype(i))
8503 C print *,"I am in true lipid"
8505 endif ! if in lipid or buffor
8507 C eliptran=elpitran+0.0 ! I am in water
8513 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8515 SUBROUTINE MATVEC2(A1,V1,V2)
8516 implicit real*8 (a-h,o-z)
8517 include 'DIMENSIONS'
8518 DIMENSION A1(2,2),V1(2),V2(2)
8522 c 3 VI=VI+A1(I,K)*V1(K)
8526 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8527 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8532 C---------------------------------------
8533 SUBROUTINE MATMAT2(A1,A2,A3)
8534 implicit real*8 (a-h,o-z)
8535 include 'DIMENSIONS'
8536 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8537 c DIMENSION AI3(2,2)
8541 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8547 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8548 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8549 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8550 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8558 c-------------------------------------------------------------------------
8559 double precision function scalar2(u,v)
8561 double precision u(2),v(2)
8564 scalar2=u(1)*v(1)+u(2)*v(2)
8568 C-----------------------------------------------------------------------------
8570 subroutine transpose2(a,at)
8572 double precision a(2,2),at(2,2)
8579 c--------------------------------------------------------------------------
8580 subroutine transpose(n,a,at)
8583 double precision a(n,n),at(n,n)
8591 C---------------------------------------------------------------------------
8592 subroutine prodmat3(a1,a2,kk,transp,prod)
8595 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8597 crc double precision auxmat(2,2),prod_(2,2)
8600 crc call transpose2(kk(1,1),auxmat(1,1))
8601 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8602 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8604 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8605 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8606 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8607 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8608 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8609 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8610 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8611 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8614 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8615 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8617 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8618 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8619 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8620 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8621 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8622 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8623 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8624 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8627 c call transpose2(a2(1,1),a2t(1,1))
8630 crc print *,((prod_(i,j),i=1,2),j=1,2)
8631 crc print *,((prod(i,j),i=1,2),j=1,2)
8635 C-----------------------------------------------------------------------------
8636 double precision function scalar(u,v)
8638 double precision u(3),v(3)
8648 C-----------------------------------------------------------------------
8649 double precision function sscale(r)
8650 double precision r,gamm
8651 include "COMMON.SPLITELE"
8652 if(r.lt.r_cut-rlamb) then
8654 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8655 gamm=(r-(r_cut-rlamb))/rlamb
8656 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8662 C-----------------------------------------------------------------------
8663 C-----------------------------------------------------------------------
8664 double precision function sscagrad(r)
8665 double precision r,gamm
8666 include "COMMON.SPLITELE"
8667 if(r.lt.r_cut-rlamb) then
8669 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8670 gamm=(r-(r_cut-rlamb))/rlamb
8671 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8677 C-----------------------------------------------------------------------
8678 C-----------------------------------------------------------------------
8679 double precision function sscalelip(r)
8680 double precision r,gamm
8681 include "COMMON.SPLITELE"
8682 C if(r.lt.r_cut-rlamb) then
8684 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8685 C gamm=(r-(r_cut-rlamb))/rlamb
8686 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8692 C-----------------------------------------------------------------------
8693 double precision function sscagradlip(r)
8694 double precision r,gamm
8695 include "COMMON.SPLITELE"
8696 C if(r.lt.r_cut-rlamb) then
8698 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8699 C gamm=(r-(r_cut-rlamb))/rlamb
8700 sscagradlip=r*(6*r-6.0d0)
8707 C-----------------------------------------------------------------------
8708 subroutine set_shield_fac
8709 implicit real*8 (a-h,o-z)
8710 include 'DIMENSIONS'
8711 include 'COMMON.CHAIN'
8712 include 'COMMON.DERIV'
8713 include 'COMMON.IOUNITS'
8714 include 'COMMON.SHIELD'
8715 include 'COMMON.INTERACT'
8716 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8717 double precision div77_81/0.974996043d0/,
8718 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8720 C the vector between center of side_chain and peptide group
8721 double precision pep_side(3),long,side_calf(3),
8722 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8723 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8724 C the line belowe needs to be changed for FGPROC>1
8726 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8728 Cif there two consequtive dummy atoms there is no peptide group between them
8729 C the line below has to be changed for FGPROC>1
8732 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8736 C first lets set vector conecting the ithe side-chain with kth side-chain
8737 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8739 C and vector conecting the side-chain with its proper calfa
8740 side_calf(j)=c(j,k+nres)-c(j,k)
8741 C side_calf(j)=2.0d0
8742 pept_group(j)=c(j,i)-c(j,i+1)
8743 C lets have their lenght
8744 dist_pep_side=pep_side(j)**2+dist_pep_side
8745 dist_side_calf=dist_side_calf+side_calf(j)**2
8746 dist_pept_group=dist_pept_group+pept_group(j)**2
8748 dist_pep_side=dsqrt(dist_pep_side)
8749 dist_pept_group=dsqrt(dist_pept_group)
8750 dist_side_calf=dsqrt(dist_side_calf)
8752 pep_side_norm(j)=pep_side(j)/dist_pep_side
8753 side_calf_norm(j)=dist_side_calf
8755 C now sscale fraction
8756 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8757 C print *,buff_shield,"buff"
8759 if (sh_frac_dist.le.0.0) cycle
8760 C If we reach here it means that this side chain reaches the shielding sphere
8761 C Lets add him to the list for gradient
8762 ishield_list(i)=ishield_list(i)+1
8763 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8764 C this list is essential otherwise problem would be O3
8765 shield_list(ishield_list(i),i)=k
8766 C Lets have the sscale value
8767 if (sh_frac_dist.gt.1.0) then
8768 scale_fac_dist=1.0d0
8770 sh_frac_dist_grad(j)=0.0d0
8773 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8774 & *(2.0*sh_frac_dist-3.0d0)
8775 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8776 & /dist_pep_side/buff_shield*0.5
8777 C remember for the final gradient multiply sh_frac_dist_grad(j)
8778 C for side_chain by factor -2 !
8780 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8781 C print *,"jestem",scale_fac_dist,fac_help_scale,
8782 C & sh_frac_dist_grad(j)
8785 C if ((i.eq.3).and.(k.eq.2)) then
8786 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8790 C this is what is now we have the distance scaling now volume...
8791 short=short_r_sidechain(itype(k))
8792 long=long_r_sidechain(itype(k))
8793 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8796 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8799 costhet_grad(j)=costhet_fac*pep_side(j)
8801 C remember for the final gradient multiply costhet_grad(j)
8802 C for side_chain by factor -2 !
8803 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8804 C pep_side0pept_group is vector multiplication
8805 pep_side0pept_group=0.0
8807 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8809 cosalfa=(pep_side0pept_group/
8810 & (dist_pep_side*dist_side_calf))
8811 fac_alfa_sin=1.0-cosalfa**2
8812 fac_alfa_sin=dsqrt(fac_alfa_sin)
8813 rkprim=fac_alfa_sin*(long-short)+short
8815 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8816 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8819 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8820 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8821 &*(long-short)/fac_alfa_sin*cosalfa/
8822 &((dist_pep_side*dist_side_calf))*
8823 &((side_calf(j))-cosalfa*
8824 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8826 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8827 &*(long-short)/fac_alfa_sin*cosalfa
8828 &/((dist_pep_side*dist_side_calf))*
8830 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
8833 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
8836 C now the gradient...
8837 C grad_shield is gradient of Calfa for peptide groups
8838 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
8840 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
8841 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
8843 grad_shield(j,i)=grad_shield(j,i)
8844 C gradient po skalowaniu
8845 & +(sh_frac_dist_grad(j)
8846 C gradient po costhet
8847 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
8848 &-scale_fac_dist*(cosphi_grad_long(j))
8849 &/(1.0-cosphi) )*div77_81
8851 C grad_shield_side is Cbeta sidechain gradient
8852 grad_shield_side(j,ishield_list(i),i)=
8853 & (sh_frac_dist_grad(j)*-2.0d0
8854 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
8855 & +scale_fac_dist*(cosphi_grad_long(j))
8856 & *2.0d0/(1.0-cosphi))
8857 & *div77_81*VofOverlap
8859 grad_shield_loc(j,ishield_list(i),i)=
8860 & scale_fac_dist*cosphi_grad_loc(j)
8861 & *2.0d0/(1.0-cosphi)
8862 & *div77_81*VofOverlap
8864 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
8866 fac_shield(i)=VolumeTotal*div77_81+div4_81
8867 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
8871 C--------------------------------------------------------------------------
8872 C first for shielding is setting of function of side-chains
8873 subroutine set_shield_fac2
8874 implicit real*8 (a-h,o-z)
8875 include 'DIMENSIONS'
8876 include 'COMMON.CHAIN'
8877 include 'COMMON.DERIV'
8878 include 'COMMON.IOUNITS'
8879 include 'COMMON.SHIELD'
8880 include 'COMMON.INTERACT'
8881 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8882 double precision div77_81/0.974996043d0/,
8883 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8885 C the vector between center of side_chain and peptide group
8886 double precision pep_side(3),long,side_calf(3),
8887 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8888 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8889 C the line belowe needs to be changed for FGPROC>1
8891 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8893 Cif there two consequtive dummy atoms there is no peptide group between them
8894 C the line below has to be changed for FGPROC>1
8897 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8901 C first lets set vector conecting the ithe side-chain with kth side-chain
8902 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8904 C and vector conecting the side-chain with its proper calfa
8905 side_calf(j)=c(j,k+nres)-c(j,k)
8906 C side_calf(j)=2.0d0
8907 pept_group(j)=c(j,i)-c(j,i+1)
8908 C lets have their lenght
8909 dist_pep_side=pep_side(j)**2+dist_pep_side
8910 dist_side_calf=dist_side_calf+side_calf(j)**2
8911 dist_pept_group=dist_pept_group+pept_group(j)**2
8913 dist_pep_side=dsqrt(dist_pep_side)
8914 dist_pept_group=dsqrt(dist_pept_group)
8915 dist_side_calf=dsqrt(dist_side_calf)
8917 pep_side_norm(j)=pep_side(j)/dist_pep_side
8918 side_calf_norm(j)=dist_side_calf
8920 C now sscale fraction
8921 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8922 C print *,buff_shield,"buff"
8924 if (sh_frac_dist.le.0.0) cycle
8925 C If we reach here it means that this side chain reaches the shielding sphere
8926 C Lets add him to the list for gradient
8927 ishield_list(i)=ishield_list(i)+1
8928 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8929 C this list is essential otherwise problem would be O3
8930 shield_list(ishield_list(i),i)=k
8931 C Lets have the sscale value
8932 if (sh_frac_dist.gt.1.0) then
8933 scale_fac_dist=1.0d0
8935 sh_frac_dist_grad(j)=0.0d0
8938 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8939 & *(2.0d0*sh_frac_dist-3.0d0)
8940 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
8941 & /dist_pep_side/buff_shield*0.5d0
8942 C remember for the final gradient multiply sh_frac_dist_grad(j)
8943 C for side_chain by factor -2 !
8945 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8946 C sh_frac_dist_grad(j)=0.0d0
8947 C scale_fac_dist=1.0d0
8948 C print *,"jestem",scale_fac_dist,fac_help_scale,
8949 C & sh_frac_dist_grad(j)
8952 C this is what is now we have the distance scaling now volume...
8953 short=short_r_sidechain(itype(k))
8954 long=long_r_sidechain(itype(k))
8955 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
8956 sinthet=short/dist_pep_side*costhet
8960 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
8961 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
8962 C & -short/dist_pep_side**2/costhet)
8965 costhet_grad(j)=costhet_fac*pep_side(j)
8967 C remember for the final gradient multiply costhet_grad(j)
8968 C for side_chain by factor -2 !
8969 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8970 C pep_side0pept_group is vector multiplication
8971 pep_side0pept_group=0.0d0
8973 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8975 cosalfa=(pep_side0pept_group/
8976 & (dist_pep_side*dist_side_calf))
8977 fac_alfa_sin=1.0d0-cosalfa**2
8978 fac_alfa_sin=dsqrt(fac_alfa_sin)
8979 rkprim=fac_alfa_sin*(long-short)+short
8983 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
8985 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
8986 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
8990 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8991 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8992 &*(long-short)/fac_alfa_sin*cosalfa/
8993 &((dist_pep_side*dist_side_calf))*
8994 &((side_calf(j))-cosalfa*
8995 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8996 C cosphi_grad_long(j)=0.0d0
8997 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
8998 &*(long-short)/fac_alfa_sin*cosalfa
8999 &/((dist_pep_side*dist_side_calf))*
9001 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9002 C cosphi_grad_loc(j)=0.0d0
9004 C print *,sinphi,sinthet
9005 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9008 C now the gradient...
9010 grad_shield(j,i)=grad_shield(j,i)
9011 C gradient po skalowaniu
9012 & +(sh_frac_dist_grad(j)*VofOverlap
9013 C gradient po costhet
9014 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9015 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9016 & sinphi/sinthet*costhet*costhet_grad(j)
9017 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9019 C grad_shield_side is Cbeta sidechain gradient
9020 grad_shield_side(j,ishield_list(i),i)=
9021 & (sh_frac_dist_grad(j)*-2.0d0
9023 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9024 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9025 & sinphi/sinthet*costhet*costhet_grad(j)
9026 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9029 grad_shield_loc(j,ishield_list(i),i)=
9030 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9031 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9032 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9036 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9038 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9039 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9040 C write(2,*) "TU",rpp(1,1),short,long,buff_shield