1 subroutine etotal(energia)
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)
15 include 'COMMON.FFIELD'
16 include 'COMMON.DERIV'
17 include 'COMMON.INTERACT'
18 include 'COMMON.SBRIDGE'
19 include 'COMMON.CHAIN'
20 include 'COMMON.SHIELD'
21 include 'COMMON.CONTROL'
22 include 'COMMON.TORCNSTR'
23 include 'COMMON.WEIGHTS'
24 include 'COMMON.WEIGHTDER'
25 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105,106) ipot
32 C Lennard-Jones potential.
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 C Gay-Berne potential (shifted LJ, angular dependence).
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
49 106 call emomo(evdw,evdw_p,evdw_m)
51 C Calculate electrostatic (H-bonding) energy of the main chain.
55 if (shield_mode.eq.1) then
57 else if (shield_mode.eq.2) then
60 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
61 C write(iout,*) 'po eelec'
63 C Calculate excluded-volume interaction energy between peptide groups
66 call escp(evdw2,evdw2_14)
68 c Calculate the bond-stretching energy
72 C write (iout,*) "estr",estr
74 C Calculate the disulfide-bridge and other energy and the contributions
75 C from other distance constraints.
76 cd print *,'Calling EHPB'
78 cd print *,'EHPB exitted succesfully.'
80 C Calculate the virtual-bond-angle energy.
82 C print *,'Bend energy finished.'
84 if (tor_mode.eq.0) then
87 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
95 if (with_theta_constr) call etheta_constr(ethetacnstr)
96 c call ebend(ebe,ethetacnstr)
97 cd print *,'Bend energy finished.'
99 C Calculate the SC local energy.
102 C print *,'SCLOC energy finished.'
104 C Calculate the virtual-bond torsional energy.
106 if (wtor.gt.0.0d0) then
107 if (tor_mode.eq.0) then
110 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
118 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
119 c print *,"Processor",myrank," computed Utor"
121 C 6/23/01 Calculate double-torsional energy
123 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
128 c print *,"Processor",myrank," computed Utord"
130 call eback_sc_corr(esccor)
133 if (wliptran.gt.0) then
134 call Eliptransfer(eliptran)
138 C 12/1/95 Multi-body terms
142 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
143 & .or. wturn6.gt.0.0d0) then
144 c write(iout,*)"calling multibody_eello"
145 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
146 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
147 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
154 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
155 c write (iout,*) "Calling multibody_hbond"
156 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
159 if (shield_mode.gt.0) then
160 etot=wsc*(evdw+evdw_t)+wscp*evdw2
163 & +wang*ebe+wtor*etors+wscloc*escloc
164 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
165 & +wcorr6*ecorr6+wturn4*eello_turn4
166 & +wturn3*eello_turn3+wturn6*eturn6
167 & +wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
168 & +wbond*estr+wsccor*esccor+ethetacnstr
171 etot=wsc*(evdw+evdw_t)+wscp*evdw2+welec*ees
173 & +wang*ebe+wtor*etors+wscloc*escloc
174 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
175 & +wcorr6*ecorr6+wturn4*eello_turn4
176 & +wturn3*eello_turn3+wturn6*eturn6
177 & +wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
178 & +wbond*estr+wsccor*esccor+ethetacnstr
182 if (shield_mode.gt.0) then
183 etot=wsc*(evdw+evdw_t)+wscp*evdw2
185 & +wang*ebe+wtor*etors+wscloc*escloc
186 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
187 & +wcorr6*ecorr6+wturn4*eello_turn4
188 & +wturn3*eello_turn3+wturn6*eturn6
189 & +wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
190 & +wbond*estr+wsccor*esccor+ethetacnstr
193 etot=wsc*(evdw+evdw_t)+wscp*evdw2
195 & +wang*ebe+wtor*etors+wscloc*escloc
196 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
197 & +wcorr6*ecorr6+wturn4*eello_turn4
198 & +wturn3*eello_turn3+wturn6*eturn6
199 & +wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
200 & +wbond*estr+wsccor*esccor+ethetacnstr
207 energia(2)=evdw2-evdw2_14
224 energia(8)=eello_turn3
225 energia(9)=eello_turn4
234 energia(20)=edihcnstr
236 energia(24)=ethetacnstr
241 if (isnan(etot).ne.0) energia(0)=1.0d+99
243 if (isnan(etot)) energia(0)=1.0d+99
248 idumm=proc_proc(etot,i)
250 call proc_proc(etot,i)
252 if(i.eq.1)energia(0)=1.0d+99
258 call enerprint(energia)
262 C Sum up the components of the Cartesian gradient.
267 if (shield_mode.eq.0) then
268 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
269 & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
271 & wstrain*ghpbc(j,i)+
272 & wcorr*gradcorr(j,i)+
273 & wel_loc*gel_loc(j,i)+
274 & wturn3*gcorr3_turn(j,i)+
275 & wturn4*gcorr4_turn(j,i)+
276 & wcorr5*gradcorr5(j,i)+
277 & wcorr6*gradcorr6(j,i)+
278 & wturn6*gcorr6_turn(j,i)+
279 & wsccor*gsccorc(j,i)
280 & +wliptran*gliptranc(j,i)
281 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
283 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
284 & wsccor*gsccorx(j,i)
285 & +wliptran*gliptranx(j,i)
287 gradc(j,i,icg)=wsc*gvdwc(j,i)
288 & +wscp*gvdwc_scp(j,i)+
289 & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
291 & wstrain*ghpbc(j,i)+
292 & wcorr*gradcorr(j,i)+
293 & wel_loc*gel_loc(j,i)+
294 & wturn3*gcorr3_turn(j,i)+
295 & wturn4*gcorr4_turn(j,i)+
296 & wcorr5*gradcorr5(j,i)+
297 & wcorr6*gradcorr6(j,i)+
298 & wturn6*gcorr6_turn(j,i)+
299 & wsccor*gsccorc(j,i)
300 & +wliptran*gliptranc(j,i)
301 & +welec*gshieldc(j,i)
302 & +welec*gshieldc_loc(j,i)
303 & +wcorr*gshieldc_ec(j,i)
304 & +wcorr*gshieldc_loc_ec(j,i)
305 & +wturn3*gshieldc_t3(j,i)
306 & +wturn3*gshieldc_loc_t3(j,i)
307 & +wturn4*gshieldc_t4(j,i)
308 & +wturn4*gshieldc_loc_t4(j,i)
309 & +wel_loc*gshieldc_ll(j,i)
310 & +wel_loc*gshieldc_loc_ll(j,i)
312 gradx(j,i,icg)=wsc*gvdwx(j,i)
313 & +wscp*gradx_scp(j,i)+
315 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
316 & wsccor*gsccorx(j,i)
317 & +wliptran*gliptranx(j,i)
318 & +welec*gshieldx(j,i)
319 & +wcorr*gshieldx_ec(j,i)
320 & +wturn3*gshieldx_t3(j,i)
321 & +wturn4*gshieldx_t4(j,i)
322 & +wel_loc*gshieldx_ll(j,i)
330 if (shield_mode.eq.0) then
331 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
332 & welec*gelc(j,i)+wstrain*ghpbc(j,i)+
334 & wcorr*gradcorr(j,i)+
335 & wel_loc*gel_loc(j,i)+
336 & wturn3*gcorr3_turn(j,i)+
337 & wturn4*gcorr4_turn(j,i)+
338 & wcorr5*gradcorr5(j,i)+
339 & wcorr6*gradcorr6(j,i)+
340 & wturn6*gcorr6_turn(j,i)+
341 & wsccor*gsccorc(j,i)
342 & +wliptran*gliptranc(j,i)
343 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
345 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
346 & wsccor*gsccorx(j,i)
347 & +wliptran*gliptranx(j,i)
349 gradc(j,i,icg)=wsc*gvdwc(j,i)+
350 & wscp*gvdwc_scp(j,i)+
351 & welec*gelc(j,i)+wstrain*ghpbc(j,i)+
353 & wcorr*gradcorr(j,i)+
354 & wel_loc*gel_loc(j,i)+
355 & wturn3*gcorr3_turn(j,i)+
356 & wturn4*gcorr4_turn(j,i)+
357 & wcorr5*gradcorr5(j,i)+
358 & wcorr6*gradcorr6(j,i)+
359 & wturn6*gcorr6_turn(j,i)+
360 & wsccor*gsccorc(j,i)
361 & +wliptran*gliptranc(j,i)
362 & +welec*gshieldc(j,i)
363 & +welec*gshieldc_loc(j,i)
364 & +wcorr*gshieldc_ec(j,i)
365 & +wcorr*gshieldc_loc_ec(j,i)
366 & +wturn3*gshieldc_t3(j,i)
367 & +wturn3*gshieldc_loc_t3(j,i)
368 & +wturn4*gshieldc_t4(j,i)
369 & +wturn4*gshieldc_loc_t4(j,i)
370 & +wel_loc*gshieldc_ll(j,i)
371 & +wel_loc*gshieldc_loc_ll(j,i)
373 gradx(j,i,icg)=wsc*gvdwx(j,i)+
374 & wscp*gradx_scp(j,i)+
376 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
377 & wsccor*gsccorx(j,i)
378 & +wliptran*gliptranx(j,i)
379 & +welec*gshieldx(j,i)
380 & +wcorr*gshieldx_ec(j,i)
381 & +wturn3*gshieldx_t3(j,i)
382 & +wturn4*gshieldx_t4(j,i)
383 & +wel_loc*gshieldx_ll(j,i)
392 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
393 & +wcorr5*g_corr5_loc(i)
394 & +wcorr6*g_corr6_loc(i)
395 & +wturn4*gel_loc_turn4(i)
396 & +wturn3*gel_loc_turn3(i)
397 & +wturn6*gel_loc_turn6(i)
398 & +wel_loc*gel_loc_loc(i)
399 c & +wsccor*gsccor_loc(i)
400 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
403 c if (dyn_ss) call dyn_set_nss
406 C------------------------------------------------------------------------
407 subroutine enerprint(energia)
408 implicit real*8 (a-h,o-z)
410 include 'DIMENSIONS.ZSCOPT'
411 include 'COMMON.IOUNITS'
412 include 'COMMON.FFIELD'
413 include 'COMMON.SBRIDGE'
414 double precision energia(0:max_ene)
416 evdw=energia(1)+energia(21)
418 evdw2=energia(2)+energia(17)
430 eello_turn3=energia(8)
431 eello_turn4=energia(9)
432 eello_turn6=energia(10)
439 edihcnstr=energia(20)
441 ethetacnstr=energia(24)
444 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,
446 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor,
447 & etors_d,wtor_d,ehpb,wstrain,
448 & ecorr,wcorr,ecorr5,wcorr5,ecorr6,wcorr6,
449 & eel_loc,wel_loc,eello_turn3,wturn3,
450 & eello_turn4,wturn4,eello_turn6,wturn6,
451 & esccor,wsccor,edihcnstr,ethetacnstr,ebr*nss,
452 & eliptran,wliptran,etot
453 10 format (/'Virtual-chain energies:'//
454 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
455 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
456 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
457 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
458 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
459 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
460 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
461 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
462 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
463 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
464 & ' (SS bridges & dist. cnstr.)'/
465 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
466 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
467 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
468 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
469 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
470 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
471 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
472 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
473 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
474 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
475 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
476 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
477 & 'ETOT= ',1pE16.6,' (total)')
479 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,estr,wbond,
480 & ebe,wang,escloc,wscloc,etors,wtor,etors_d,wtor_d,
481 & ehpb,wstrain,ecorr,wcorr,ecorr5,wcorr5,
482 & ecorr6,wcorr6,eel_loc,wel_loc,
483 & eello_turn3,wturn3,eello_turn4,wturn4,
484 & eello_turn6,wturn6,esccor,wsccor,
485 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot
486 10 format (/'Virtual-chain energies:'//
487 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
488 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
489 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
490 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
491 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
492 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
493 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
494 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
495 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
496 & ' (SS bridges & dist. cnstr.)'/
497 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
498 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
499 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
500 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
501 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
502 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
503 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
504 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
505 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
506 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
507 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
508 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
509 & 'ETOT= ',1pE16.6,' (total)')
513 C-----------------------------------------------------------------------
516 C This subroutine calculates the interaction energy of nonbonded side chains
517 C assuming the LJ potential of interaction.
519 implicit real*8 (a-h,o-z)
521 include 'DIMENSIONS.ZSCOPT'
522 parameter (accur=1.0d-10)
525 include 'COMMON.LOCAL'
526 include 'COMMON.CHAIN'
527 include 'COMMON.DERIV'
528 include 'COMMON.INTERACT'
529 include 'COMMON.TORSION'
530 include 'COMMON.WEIGHTDER'
531 include 'COMMON.SBRIDGE'
532 include 'COMMON.NAMES'
533 include 'COMMON.IOUNITS'
534 include 'COMMON.CONTACTS'
538 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
541 eneps_temp(j,i)=0.0d0
554 C Calculate SC interaction energy.
557 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
558 cd & 'iend=',iend(i,iint)
559 do j=istart(i,iint),iend(i,iint)
564 C Change 12/1/95 to calculate four-body interactions
565 rij=xj*xj+yj*yj+zj*zj
567 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
568 eps0ij=eps(itypi,itypj)
570 e1=fac*fac*aa(itypi,itypj)
571 e2=fac*bb(itypi,itypj)
573 ij=icant(itypi,itypj)
574 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
575 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
576 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
577 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
578 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
579 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
580 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
581 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
585 C Calculate the components of the gradient in DC and X
587 fac=-rrij*(e1+evdwij)
592 gvdwx(k,i)=gvdwx(k,i)-gg(k)
593 gvdwx(k,j)=gvdwx(k,j)+gg(k)
597 gvdwc(l,k)=gvdwc(l,k)+gg(l)
602 C 12/1/95, revised on 5/20/97
604 C Calculate the contact function. The ith column of the array JCONT will
605 C contain the numbers of atoms that make contacts with the atom I (of numbers
606 C greater than I). The arrays FACONT and GACONT will contain the values of
607 C the contact function and its derivative.
609 C Uncomment next line, if the correlation interactions include EVDW explicitly.
610 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
611 C Uncomment next line, if the correlation interactions are contact function only
612 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
614 sigij=sigma(itypi,itypj)
615 r0ij=rs0(itypi,itypj)
617 C Check whether the SC's are not too far to make a contact.
620 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
621 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
623 if (fcont.gt.0.0D0) then
624 C If the SC-SC distance if close to sigma, apply spline.
625 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
626 cAdam & fcont1,fprimcont1)
627 cAdam fcont1=1.0d0-fcont1
628 cAdam if (fcont1.gt.0.0d0) then
629 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
630 cAdam fcont=fcont*fcont1
632 C Uncomment following 4 lines to have the geometric average of the epsilon0's
633 cga eps0ij=1.0d0/dsqrt(eps0ij)
635 cga gg(k)=gg(k)*eps0ij
637 cga eps0ij=-evdwij*eps0ij
638 C Uncomment for AL's type of SC correlation interactions.
640 num_conti=num_conti+1
642 facont(num_conti,i)=fcont*eps0ij
643 fprimcont=eps0ij*fprimcont/rij
645 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
646 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
647 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
648 C Uncomment following 3 lines for Skolnick's type of SC correlation.
649 gacont(1,num_conti,i)=-fprimcont*xj
650 gacont(2,num_conti,i)=-fprimcont*yj
651 gacont(3,num_conti,i)=-fprimcont*zj
652 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
653 cd write (iout,'(2i3,3f10.5)')
654 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
660 num_cont(i)=num_conti
665 gvdwc(j,i)=expon*gvdwc(j,i)
666 gvdwx(j,i)=expon*gvdwx(j,i)
670 C******************************************************************************
674 C To save time, the factor of EXPON has been extracted from ALL components
675 C of GVDWC and GRADX. Remember to multiply them by this factor before further
678 C******************************************************************************
681 C-----------------------------------------------------------------------------
682 subroutine eljk(evdw)
684 C This subroutine calculates the interaction energy of nonbonded side chains
685 C assuming the LJK potential of interaction.
687 implicit real*8 (a-h,o-z)
689 include 'DIMENSIONS.ZSCOPT'
692 include 'COMMON.LOCAL'
693 include 'COMMON.CHAIN'
694 include 'COMMON.DERIV'
695 include 'COMMON.INTERACT'
696 include 'COMMON.WEIGHTDER'
697 include 'COMMON.IOUNITS'
698 include 'COMMON.NAMES'
703 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
706 eneps_temp(j,i)=0.0d0
717 C Calculate SC interaction energy.
720 do j=istart(i,iint),iend(i,iint)
725 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
727 e_augm=augm(itypi,itypj)*fac_augm
730 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
731 fac=r_shift_inv**expon
732 e1=fac*fac*aa(itypi,itypj)
733 e2=fac*bb(itypi,itypj)
735 ij=icant(itypi,itypj)
736 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
737 & /dabs(eps(itypi,itypj))
738 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
739 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
740 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
741 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
742 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
743 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
744 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
745 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
749 C Calculate the components of the gradient in DC and X
751 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
756 gvdwx(k,i)=gvdwx(k,i)-gg(k)
757 gvdwx(k,j)=gvdwx(k,j)+gg(k)
761 gvdwc(l,k)=gvdwc(l,k)+gg(l)
771 gvdwc(j,i)=expon*gvdwc(j,i)
772 gvdwx(j,i)=expon*gvdwx(j,i)
778 C-----------------------------------------------------------------------------
781 C This subroutine calculates the interaction energy of nonbonded side chains
782 C assuming the Berne-Pechukas potential of interaction.
784 implicit real*8 (a-h,o-z)
786 include 'DIMENSIONS.ZSCOPT'
789 include 'COMMON.LOCAL'
790 include 'COMMON.CHAIN'
791 include 'COMMON.DERIV'
792 include 'COMMON.NAMES'
793 include 'COMMON.INTERACT'
794 include 'COMMON.WEIGHTDER'
795 include 'COMMON.IOUNITS'
796 include 'COMMON.CALC'
798 c double precision rrsave(maxdim)
804 eneps_temp(j,i)=0.0d0
808 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
810 c if (icall.eq.0) then
822 dxi=dc_norm(1,nres+i)
823 dyi=dc_norm(2,nres+i)
824 dzi=dc_norm(3,nres+i)
825 dsci_inv=vbld_inv(i+nres)
827 C Calculate SC interaction energy.
830 do j=istart(i,iint),iend(i,iint)
833 dscj_inv=vbld_inv(j+nres)
834 chi1=chi(itypi,itypj)
835 chi2=chi(itypj,itypi)
842 alf12=0.5D0*(alf1+alf2)
843 C For diagnostics only!!!
856 dxj=dc_norm(1,nres+j)
857 dyj=dc_norm(2,nres+j)
858 dzj=dc_norm(3,nres+j)
859 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
860 cd if (icall.eq.0) then
866 C Calculate the angle-dependent terms of energy & contributions to derivatives.
868 C Calculate whole angle-dependent part of epsilon and contributions
870 fac=(rrij*sigsq)**expon2
871 e1=fac*fac*aa(itypi,itypj)
872 e2=fac*bb(itypi,itypj)
873 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
874 eps2der=evdwij*eps3rt
875 eps3der=evdwij*eps2rt
876 evdwij=evdwij*eps2rt*eps3rt
877 ij=icant(itypi,itypj)
878 aux=eps1*eps2rt**2*eps3rt**2
879 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
880 & /dabs(eps(itypi,itypj))
881 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
885 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
886 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
887 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
888 cd & restyp(itypi),i,restyp(itypj),j,
889 cd & epsi,sigm,chi1,chi2,chip1,chip2,
890 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
891 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
894 C Calculate gradient components.
895 e1=e1*eps1*eps2rt**2*eps3rt**2
896 fac=-expon*(e1+evdwij)
899 C Calculate radial part of the gradient
903 C Calculate the angular part of the gradient and sum add the contributions
904 C to the appropriate components of the Cartesian gradient.
913 C-----------------------------------------------------------------------------
916 C This subroutine calculates the interaction energy of nonbonded side chains
917 C assuming the Gay-Berne potential of interaction.
919 implicit real*8 (a-h,o-z)
921 include 'DIMENSIONS.ZSCOPT'
924 include 'COMMON.LOCAL'
925 include 'COMMON.CHAIN'
926 include 'COMMON.DERIV'
927 include 'COMMON.NAMES'
928 include 'COMMON.INTERACT'
929 include 'COMMON.WEIGHTDER'
930 include 'COMMON.IOUNITS'
931 include 'COMMON.CALC'
938 eneps_temp(j,i)=0.0d0
942 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
945 c if (icall.gt.0) lprn=.true.
949 if (itypi.eq.ntyp1) cycle
954 dxi=dc_norm(1,nres+i)
955 dyi=dc_norm(2,nres+i)
956 dzi=dc_norm(3,nres+i)
957 dsci_inv=vbld_inv(i+nres)
959 C Calculate SC interaction energy.
962 do j=istart(i,iint),iend(i,iint)
965 if (itypj.eq.ntyp1) cycle
966 dscj_inv=vbld_inv(j+nres)
967 sig0ij=sigma(itypi,itypj)
968 chi1=chi(itypi,itypj)
969 chi2=chi(itypj,itypi)
976 alf12=0.5D0*(alf1+alf2)
977 C For diagnostics only!!!
990 dxj=dc_norm(1,nres+j)
991 dyj=dc_norm(2,nres+j)
992 dzj=dc_norm(3,nres+j)
993 c write (iout,*) i,j,xj,yj,zj
994 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
996 C Calculate angle-dependent terms of energy and contributions to their
1000 sig=sig0ij*dsqrt(sigsq)
1001 rij_shift=1.0D0/rij-sig+sig0ij
1002 C I hate to put IF's in the loops, but here don't have another choice!!!!
1003 if (rij_shift.le.0.0D0) then
1008 c---------------------------------------------------------------
1009 rij_shift=1.0D0/rij_shift
1010 fac=rij_shift**expon
1011 e1=fac*fac*aa(itypi,itypj)
1012 e2=fac*bb(itypi,itypj)
1013 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1014 eps2der=evdwij*eps3rt
1015 eps3der=evdwij*eps2rt
1016 evdwij=evdwij*eps2rt*eps3rt
1018 ij=icant(itypi,itypj)
1019 aux=eps1*eps2rt**2*eps3rt**2
1020 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1021 c & /dabs(eps(itypi,itypj))
1022 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1023 c-----------------------
1024 eps0ij=eps(itypi,itypj)
1025 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1/ftune_eps(eps0ij)
1026 rr0ij=r0(itypi,itypj)
1027 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps0ij
1028 c eneps_temp(2,ij)=eneps_temp(2,ij)+(rij_shift*rr0ij)**expon
1029 c-----------------------
1030 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1031 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1032 c & aux*e2/eps(itypi,itypj)
1034 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1035 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1036 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1037 & restyp(itypi),i,restyp(itypj),j,
1038 & epsi,sigm,chi1,chi2,chip1,chip2,
1039 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1040 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1044 C Calculate gradient components.
1045 e1=e1*eps1*eps2rt**2*eps3rt**2
1046 fac=-expon*(e1+evdwij)*rij_shift
1049 C Calculate the radial part of the gradient
1053 C Calculate angular part of the gradient.
1061 C-----------------------------------------------------------------------------
1062 subroutine egbv(evdw)
1064 C This subroutine calculates the interaction energy of nonbonded side chains
1065 C assuming the Gay-Berne-Vorobjev potential of interaction.
1067 implicit real*8 (a-h,o-z)
1068 include 'DIMENSIONS'
1069 include 'DIMENSIONS.ZSCOPT'
1070 include 'COMMON.GEO'
1071 include 'COMMON.VAR'
1072 include 'COMMON.LOCAL'
1073 include 'COMMON.CHAIN'
1074 include 'COMMON.DERIV'
1075 include 'COMMON.NAMES'
1076 include 'COMMON.INTERACT'
1077 include 'COMMON.WEIGHTDER'
1078 include 'COMMON.IOUNITS'
1079 include 'COMMON.CALC'
1080 common /srutu/ icall
1086 eneps_temp(j,i)=0.0d0
1090 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1093 c if (icall.gt.0) lprn=.true.
1095 do i=iatsc_s,iatsc_e
1101 dxi=dc_norm(1,nres+i)
1102 dyi=dc_norm(2,nres+i)
1103 dzi=dc_norm(3,nres+i)
1104 dsci_inv=vbld_inv(i+nres)
1106 C Calculate SC interaction energy.
1108 do iint=1,nint_gr(i)
1109 do j=istart(i,iint),iend(i,iint)
1112 dscj_inv=vbld_inv(j+nres)
1113 sig0ij=sigma(itypi,itypj)
1114 r0ij=r0(itypi,itypj)
1115 chi1=chi(itypi,itypj)
1116 chi2=chi(itypj,itypi)
1123 alf12=0.5D0*(alf1+alf2)
1124 C For diagnostics only!!!
1137 dxj=dc_norm(1,nres+j)
1138 dyj=dc_norm(2,nres+j)
1139 dzj=dc_norm(3,nres+j)
1140 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1142 C Calculate angle-dependent terms of energy and contributions to their
1146 sig=sig0ij*dsqrt(sigsq)
1147 rij_shift=1.0D0/rij-sig+r0ij
1148 C I hate to put IF's in the loops, but here don't have another choice!!!!
1149 if (rij_shift.le.0.0D0) then
1154 c---------------------------------------------------------------
1155 rij_shift=1.0D0/rij_shift
1156 fac=rij_shift**expon
1157 e1=fac*fac*aa(itypi,itypj)
1158 e2=fac*bb(itypi,itypj)
1159 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1160 eps2der=evdwij*eps3rt
1161 eps3der=evdwij*eps2rt
1162 fac_augm=rrij**expon
1163 e_augm=augm(itypi,itypj)*fac_augm
1164 evdwij=evdwij*eps2rt*eps3rt
1165 evdw=evdw+evdwij+e_augm
1166 ij=icant(itypi,itypj)
1167 aux=eps1*eps2rt**2*eps3rt**2
1168 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1169 & /dabs(eps(itypi,itypj))
1170 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1171 c eneps_temp(ij)=eneps_temp(ij)
1172 c & +(evdwij+e_augm)/eps(itypi,itypj)
1174 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1175 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1176 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1177 c & restyp(itypi),i,restyp(itypj),j,
1178 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1179 c & chi1,chi2,chip1,chip2,
1180 c & eps1,eps2rt**2,eps3rt**2,
1181 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1185 C Calculate gradient components.
1186 e1=e1*eps1*eps2rt**2*eps3rt**2
1187 fac=-expon*(e1+evdwij)*rij_shift
1189 fac=rij*fac-2*expon*rrij*e_augm
1190 C Calculate the radial part of the gradient
1194 C Calculate angular part of the gradient.
1202 C-----------------------------------------------------------------------------
1203 SUBROUTINE emomo(evdw,evdw_p,evdw_m)
1205 C This subroutine calculates the interaction energy of nonbonded side chains
1206 C assuming the Gay-Berne potential of interaction.
1209 INCLUDE 'DIMENSIONS'
1210 INCLUDE 'DIMENSIONS.ZSCOPT'
1211 INCLUDE 'COMMON.CALC'
1212 INCLUDE 'COMMON.CONTROL'
1213 INCLUDE 'COMMON.CHAIN'
1214 INCLUDE 'COMMON.DERIV'
1215 INCLUDE 'COMMON.EMP'
1216 INCLUDE 'COMMON.GEO'
1217 INCLUDE 'COMMON.INTERACT'
1218 INCLUDE 'COMMON.IOUNITS'
1219 INCLUDE 'COMMON.LOCAL'
1220 INCLUDE 'COMMON.NAMES'
1221 INCLUDE 'COMMON.VAR'
1222 INCLUDE 'COMMON.WEIGHTDER'
1224 double precision scalar
1225 double precision ener(4)
1231 IF (energy_dec) write (iout,'(a)')
1232 & ' AAi i AAj j 1/rij Rtail Rhead evdwij Fcav Ecl
1233 & Egb Epol Fisocav Elj Equad evdw'
1238 ccccc energy_dec=.false.
1239 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1241 c if (icall.eq.0) lprn=.false.
1244 DO i = iatsc_s, iatsc_e
1246 c itypi1 = itype(i+1)
1247 dxi = dc_norm(1,nres+i)
1248 dyi = dc_norm(2,nres+i)
1249 dzi = dc_norm(3,nres+i)
1250 c dsci_inv=dsc_inv(itypi)
1251 dsci_inv = vbld_inv(i+nres)
1253 c ctail(k,1) = c(k, i+nres)
1254 c & - dtail(1,itypi,itypj) * dc_norm(k, nres+i)
1259 c!-------------------------------------------------------------------
1260 C Calculate SC interaction energy.
1261 DO iint = 1, nint_gr(i)
1262 DO j = istart(i,iint), iend(i,iint)
1263 c! initialize variables for electrostatic gradients
1264 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
1266 c dscj_inv = dsc_inv(itypj)
1267 dscj_inv = vbld_inv(j+nres)
1268 c! rij holds 1/(distance of Calpha atoms)
1269 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
1271 c!-------------------------------------------------------------------
1272 C Calculate angle-dependent terms of energy and contributions to their
1276 c! DO troll = 10, 5000
1280 c! sqom1 = om1 * om1
1281 c! sqom2 = om2 * om2
1282 c! sqom12 = om12 * om12
1283 c! rij = 5.0d0 / troll
1285 c! Rtail = troll / 5.0d0
1286 c! Rhead = troll / 5.0d0
1287 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1288 c! Rtail = dsqrt((Rtail**2)
1289 c! & +((dabs(dtail(1,itypi,itypj)-dtail(2,itypi,itypj)))**2))
1290 c! rij = 1.0d0/Rtail
1294 c! this should be in elgrad_init but om's are calculated by sc_angular
1295 c! which in turn is used by older potentials
1296 c! which proves how tangled UNRES code is >.<
1297 c! om = omega, sqom = om^2
1300 sqom12 = om12 * om12
1302 c! now we calculate EGB - Gey-Berne
1303 c! It will be summed up in evdwij and saved in evdw
1304 sigsq = 1.0D0 / sigsq
1305 sig = sig0ij * dsqrt(sigsq)
1306 c! rij_shift = 1.0D0 / rij - sig + sig0ij
1307 rij_shift = Rtail - sig + sig0ij
1308 IF (rij_shift.le.0.0D0) THEN
1312 sigder = -sig * sigsq
1313 rij_shift = 1.0D0 / rij_shift
1314 fac = rij_shift**expon
1315 c1 = fac * fac * aa(itypi,itypj)
1317 c2 = fac * bb(itypi,itypj)
1319 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
1320 eps2der = eps3rt * evdwij
1321 eps3der = eps2rt * evdwij
1322 c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
1323 evdwij = eps2rt * eps3rt * evdwij
1325 c! write (*,*) "Gey Berne = ", evdwij
1327 IF (bb(itypi,itypj).gt.0) THEN
1328 evdw_p = evdw_p + evdwij
1330 evdw_m = evdw_m + evdwij
1336 c!-------------------------------------------------------------------
1337 c! Calculate some components of GGB
1338 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
1339 fac = -expon * (c1 + evdwij) * rij_shift
1340 sigder = fac * sigder
1342 c! Calculate distance derivative
1349 c! write (*,*) "gg(1) = ", gg(1)
1350 c! write (*,*) "gg(2) = ", gg(2)
1351 c! write (*,*) "gg(3) = ", gg(3)
1352 c! The angular derivatives of GGB are brought together in sc_grad
1353 c!-------------------------------------------------------------------
1356 c! Catch gly-gly interactions to skip calculation of something that
1359 IF (itypi.eq.10.and.itypj.eq.10) THEN
1367 c! we are not 2 glycines, so we calculate Fcav (and maybe more)
1368 fac = chis1 * sqom1 + chis2 * sqom2
1369 & - 2.0d0 * chis12 * om1 * om2 * om12
1370 c! we will use pom later in Gcav, so dont mess with it!
1371 pom = 1.0d0 - chis1 * chis2 * sqom12
1373 Lambf = (1.0d0 - (fac / pom))
1374 Lambf = dsqrt(Lambf)
1377 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
1378 c! write (*,*) "sparrow = ", sparrow
1379 Chif = Rtail * sparrow
1380 ChiLambf = Chif * Lambf
1381 eagle = dsqrt(ChiLambf)
1382 bat = ChiLambf ** 11.0d0
1384 top = b1 * ( eagle + b2 * ChiLambf - b3 )
1385 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
1388 c! write (*,*) "sig1 = ",sig1
1389 c! write (*,*) "sig2 = ",sig2
1390 c! write (*,*) "Rtail = ",Rtail
1391 c! write (*,*) "sparrow = ",sparrow
1392 c! write (*,*) "Chis1 = ", chis1
1393 c! write (*,*) "Chis2 = ", chis2
1394 c! write (*,*) "Chis12 = ", chis12
1395 c! write (*,*) "om1 = ", om1
1396 c! write (*,*) "om2 = ", om2
1397 c! write (*,*) "om12 = ", om12
1398 c! write (*,*) "sqom1 = ", sqom1
1399 c! write (*,*) "sqom2 = ", sqom2
1400 c! write (*,*) "sqom12 = ", sqom12
1401 c! write (*,*) "Lambf = ",Lambf
1402 c! write (*,*) "b1 = ",b1
1403 c! write (*,*) "b2 = ",b2
1404 c! write (*,*) "b3 = ",b3
1405 c! write (*,*) "b4 = ",b4
1406 c! write (*,*) "top = ",top
1407 c! write (*,*) "bot = ",bot
1410 c! write (*,*) "Fcav = ", Fcav
1411 c!-------------------------------------------------------------------
1412 c! derivative of Fcav is Gcav...
1413 c!---------------------------------------------------
1415 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
1416 dbot = 12.0d0 * b4 * bat * Lambf
1417 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
1419 c! write (*,*) "dFcav/dR = ", dFdR
1421 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
1422 dbot = 12.0d0 * b4 * bat * Chif
1424 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
1425 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
1426 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
1427 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
1429 dFdL = ((dtop * bot - top * dbot) / botsq)
1431 dCAVdOM1 = dFdL * ( dFdOM1 )
1432 dCAVdOM2 = dFdL * ( dFdOM2 )
1433 dCAVdOM12 = dFdL * ( dFdOM12 )
1434 c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1
1435 c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2
1436 c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12
1438 c!-------------------------------------------------------------------
1439 c! Finally, add the distance derivatives of GB and Fcav to gvdwc
1440 c! Pom is used here to project the gradient vector into
1441 c! cartesian coordinates and at the same time contains
1442 c! dXhb/dXsc derivative (for charged amino acids
1443 c! location of hydrophobic centre of interaction is not
1444 c! the same as geometric centre of side chain, this
1445 c! derivative takes that into account)
1446 c! derivatives of omega angles will be added in sc_grad
1449 ertail(k) = Rtail_distance(k)/Rtail
1451 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
1452 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
1453 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1454 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1456 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1457 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1458 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
1459 gvdwx(k,i) = gvdwx(k,i)
1460 & - (( dFdR + gg(k) ) * pom)
1461 c! & - ( dFdR * pom )
1462 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
1463 gvdwx(k,j) = gvdwx(k,j)
1464 & + (( dFdR + gg(k) ) * pom)
1465 c! & + ( dFdR * pom )
1467 gvdwc(k,i) = gvdwc(k,i)
1468 & - (( dFdR + gg(k) ) * ertail(k))
1469 c! & - ( dFdR * ertail(k))
1471 gvdwc(k,j) = gvdwc(k,j)
1472 & + (( dFdR + gg(k) ) * ertail(k))
1473 c! & + ( dFdR * ertail(k))
1476 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1477 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1480 c!-------------------------------------------------------------------
1481 c! Compute head-head and head-tail energies for each state
1483 isel = iabs(Qi) + iabs(Qj)
1485 c! No charges - do nothing
1488 ELSE IF (isel.eq.4) THEN
1489 c! Calculate dipole-dipole interactions
1493 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
1494 c! Charge-nonpolar interactions
1498 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
1499 c! Nonpolar-charge interactions
1503 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
1504 c! Charge-dipole interactions
1505 CALL eqd(ecl, elj, epol)
1506 eheadtail = ECL + elj + epol
1508 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
1509 c! Dipole-charge interactions
1510 CALL edq(ecl, elj, epol)
1511 eheadtail = ECL + elj + epol
1513 ELSE IF ((isel.eq.2.and.
1514 & iabs(Qi).eq.1).and.
1515 & nstate(itypi,itypj).eq.1) THEN
1516 c! Same charge-charge interaction ( +/+ or -/- )
1517 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
1518 eheadtail = ECL + Egb + Epol + Fisocav + Elj
1520 ELSE IF ((isel.eq.2.and.
1521 & iabs(Qi).eq.1).and.
1522 & nstate(itypi,itypj).ne.1) THEN
1523 c! Different charge-charge interaction ( +/- or -/+ )
1525 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1527 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
1528 c! write (*,*) "evdw = ", evdw
1529 c! write (*,*) "Fcav = ", Fcav
1530 c! write (*,*) "eheadtail = ", eheadtail
1534 ij=icant(itypi,itypj)
1535 eneps_temp(1,ij)=eneps_temp(1,ij)+evdwij
1536 eneps_temp(2,ij)=eneps_temp(2,ij)+Fcav
1537 eneps_temp(3,ij)=eheadtail
1538 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,9f16.7)')
1539 & restyp(itype(i)),i,restyp(itype(j)),j,
1540 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1542 IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
1543 & restyp(itype(i)),i,restyp(itype(j)),j,
1544 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1551 c!-------------------------------------------------------------------
1552 c! As all angular derivatives are done, now we sum them up,
1553 c! then transform and project into cartesian vectors and add to gvdwc
1554 c! We call sc_grad always, with the exception of +/- interaction.
1555 c! This is because energy_quad subroutine needs to handle
1556 c! this job in his own way.
1557 c! This IS probably not very efficient and SHOULD be optimised
1558 c! but it will require major restructurization of emomo
1559 c! so it will be left as it is for now
1560 c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj)
1561 IF (nstate(itypi,itypj).eq.1) THEN
1563 IF (bb(itypi,itypj).gt.0) THEN
1572 c!-------------------------------------------------------------------
1577 c write (iout,*) "Number of loop steps in EGB:",ind
1578 c energy_dec=.false.
1580 END SUBROUTINE emomo
1582 C-----------------------------------------------------------------------------
1583 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
1585 INCLUDE 'DIMENSIONS'
1586 INCLUDE 'DIMENSIONS.ZSCOPT'
1587 INCLUDE 'COMMON.CALC'
1588 INCLUDE 'COMMON.CHAIN'
1589 INCLUDE 'COMMON.CONTROL'
1590 INCLUDE 'COMMON.DERIV'
1591 INCLUDE 'COMMON.EMP'
1592 INCLUDE 'COMMON.GEO'
1593 INCLUDE 'COMMON.INTERACT'
1594 INCLUDE 'COMMON.IOUNITS'
1595 INCLUDE 'COMMON.LOCAL'
1596 INCLUDE 'COMMON.NAMES'
1597 INCLUDE 'COMMON.VAR'
1598 double precision scalar, facd3, facd4, federmaus, adler
1599 c! Epol and Gpol analytical parameters
1600 alphapol1 = alphapol(itypi,itypj)
1601 alphapol2 = alphapol(itypj,itypi)
1602 c! Fisocav and Gisocav analytical parameters
1603 al1 = alphiso(1,itypi,itypj)
1604 al2 = alphiso(2,itypi,itypj)
1605 al3 = alphiso(3,itypi,itypj)
1606 al4 = alphiso(4,itypi,itypj)
1608 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1609 & + sigiso2(itypi,itypj)**2.0d0))
1611 pis = sig0head(itypi,itypj)
1612 eps_head = epshead(itypi,itypj)
1613 Rhead_sq = Rhead * Rhead
1614 c! R1 - distance between head of ith side chain and tail of jth sidechain
1615 c! R2 - distance between head of jth side chain and tail of ith sidechain
1619 c! Calculate head-to-tail distances needed by Epol
1620 R1=R1+(ctail(k,2)-chead(k,1))**2
1621 R2=R2+(chead(k,2)-ctail(k,1))**2
1627 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1628 c! & +dhead(1,1,itypi,itypj))**2))
1629 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1630 c! & +dhead(2,1,itypi,itypj))**2))
1631 c!-------------------------------------------------------------------
1632 c! Coulomb electrostatic interaction
1633 Ecl = (332.0d0 * Qij) / Rhead
1634 c! derivative of Ecl is Gcl...
1635 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
1639 c!-------------------------------------------------------------------
1640 c! Generalised Born Solvent Polarization
1641 c! Charged head polarizes the solvent
1642 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1643 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1644 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1645 c! Derivative of Egb is Ggb...
1646 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1647 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1649 dGGBdR = dGGBdFGB * dFGBdR
1650 c!-------------------------------------------------------------------
1651 c! Fisocav - isotropic cavity creation term
1652 c! or "how much energy it costs to put charged head in water"
1654 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1655 bot = (1.0d0 + al4 * pom**12.0d0)
1658 c! write (*,*) "Rhead = ",Rhead
1659 c! write (*,*) "csig = ",csig
1660 c! write (*,*) "pom = ",pom
1661 c! write (*,*) "al1 = ",al1
1662 c! write (*,*) "al2 = ",al2
1663 c! write (*,*) "al3 = ",al3
1664 c! write (*,*) "al4 = ",al4
1665 c! write (*,*) "top = ",top
1666 c! write (*,*) "bot = ",bot
1667 c! Derivative of Fisocav is GCV...
1668 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1669 dbot = 12.0d0 * al4 * pom ** 11.0d0
1670 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1671 c!-------------------------------------------------------------------
1673 c! Polarization energy - charged heads polarize hydrophobic "neck"
1674 MomoFac1 = (1.0d0 - chi1 * sqom2)
1675 MomoFac2 = (1.0d0 - chi2 * sqom1)
1676 RR1 = ( R1 * R1 ) / MomoFac1
1677 RR2 = ( R2 * R2 ) / MomoFac2
1678 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1679 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1680 fgb1 = sqrt( RR1 + a12sq * ee1 )
1681 fgb2 = sqrt( RR2 + a12sq * ee2 )
1682 epol = 332.0d0 * eps_inout_fac * (
1683 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1685 c write (*,*) "eps_inout_fac = ",eps_inout_fac
1686 c write (*,*) "alphapol1 = ", alphapol1
1687 c write (*,*) "alphapol2 = ", alphapol2
1688 c write (*,*) "fgb1 = ", fgb1
1689 c write (*,*) "fgb2 = ", fgb2
1690 c write (*,*) "epol = ", epol
1691 c! derivative of Epol is Gpol...
1692 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1694 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1696 dFGBdR1 = ( (R1 / MomoFac1)
1697 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1698 & / ( 2.0d0 * fgb1 )
1699 dFGBdR2 = ( (R2 / MomoFac2)
1700 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1701 & / ( 2.0d0 * fgb2 )
1702 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1703 & * ( 2.0d0 - 0.5d0 * ee1) )
1704 & / ( 2.0d0 * fgb1 )
1705 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1706 & * ( 2.0d0 - 0.5d0 * ee2) )
1707 & / ( 2.0d0 * fgb2 )
1708 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1710 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1712 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1714 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1716 c!-------------------------------------------------------------------
1718 c! Lennard-Jones 6-12 interaction between heads
1719 pom = (pis / Rhead)**6.0d0
1720 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1721 c! derivative of Elj is Glj
1722 dGLJdR = 4.0d0 * eps_head
1723 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1724 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1725 c!-------------------------------------------------------------------
1726 c! Return the results
1727 c! These things do the dRdX derivatives, that is
1728 c! allow us to change what we see from function that changes with
1729 c! distance to function that changes with LOCATION (of the interaction
1732 erhead(k) = Rhead_distance(k)/Rhead
1733 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1734 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1737 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1738 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1739 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1740 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1741 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1742 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1743 facd1 = d1 * vbld_inv(i+nres)
1744 facd2 = d2 * vbld_inv(j+nres)
1745 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1746 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1748 c! Now we add appropriate partial derivatives (one in each dimension)
1750 hawk = (erhead_tail(k,1) +
1751 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
1752 condor = (erhead_tail(k,2) +
1753 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
1755 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1756 gvdwx(k,i) = gvdwx(k,i)
1761 & - dPOLdR2 * (erhead_tail(k,2)
1762 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1765 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1766 gvdwx(k,j) = gvdwx(k,j)
1770 & + dPOLdR1 * (erhead_tail(k,1)
1771 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1772 & + dPOLdR2 * condor
1775 gvdwc(k,i) = gvdwc(k,i)
1776 & - dGCLdR * erhead(k)
1777 & - dGGBdR * erhead(k)
1778 & - dGCVdR * erhead(k)
1779 & - dPOLdR1 * erhead_tail(k,1)
1780 & - dPOLdR2 * erhead_tail(k,2)
1781 & - dGLJdR * erhead(k)
1783 gvdwc(k,j) = gvdwc(k,j)
1784 & + dGCLdR * erhead(k)
1785 & + dGGBdR * erhead(k)
1786 & + dGCVdR * erhead(k)
1787 & + dPOLdR1 * erhead_tail(k,1)
1788 & + dPOLdR2 * erhead_tail(k,2)
1789 & + dGLJdR * erhead(k)
1794 c!-------------------------------------------------------------------
1795 SUBROUTINE energy_quad
1796 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1798 INCLUDE 'DIMENSIONS'
1799 INCLUDE 'DIMENSIONS.ZSCOPT'
1800 INCLUDE 'COMMON.CALC'
1801 INCLUDE 'COMMON.CHAIN'
1802 INCLUDE 'COMMON.CONTROL'
1803 INCLUDE 'COMMON.DERIV'
1804 INCLUDE 'COMMON.EMP'
1805 INCLUDE 'COMMON.GEO'
1806 INCLUDE 'COMMON.INTERACT'
1807 INCLUDE 'COMMON.IOUNITS'
1808 INCLUDE 'COMMON.LOCAL'
1809 INCLUDE 'COMMON.NAMES'
1810 INCLUDE 'COMMON.VAR'
1811 double precision scalar
1812 double precision ener(4)
1813 double precision dcosom1(3),dcosom2(3)
1814 c! used in Epol derivatives
1815 double precision facd3, facd4
1816 double precision federmaus, adler
1817 c! Epol and Gpol analytical parameters
1818 alphapol1 = alphapol(itypi,itypj)
1819 alphapol2 = alphapol(itypj,itypi)
1820 c! Fisocav and Gisocav analytical parameters
1821 al1 = alphiso(1,itypi,itypj)
1822 al2 = alphiso(2,itypi,itypj)
1823 al3 = alphiso(3,itypi,itypj)
1824 al4 = alphiso(4,itypi,itypj)
1826 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1827 & + sigiso2(itypi,itypj)**2.0d0))
1829 w1 = wqdip(1,itypi,itypj)
1830 w2 = wqdip(2,itypi,itypj)
1831 pis = sig0head(itypi,itypj)
1832 eps_head = epshead(itypi,itypj)
1833 c! First things first:
1834 c! We need to do sc_grad's job with GB and Fcav
1836 & eps2der * eps2rt_om1
1837 & - 2.0D0 * alf1 * eps3der
1838 & + sigder * sigsq_om1
1841 & eps2der * eps2rt_om2
1842 & + 2.0D0 * alf2 * eps3der
1843 & + sigder * sigsq_om2
1846 & evdwij * eps1_om12
1847 & + eps2der * eps2rt_om12
1848 & - 2.0D0 * alf12 * eps3der
1849 & + sigder *sigsq_om12
1851 c! now some magical transformations to project gradient into
1852 c! three cartesian vectors
1854 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1855 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1856 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
1857 c! this acts on hydrophobic center of interaction
1858 gvdwx(k,i)= gvdwx(k,i) - gg(k)
1859 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1860 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1861 gvdwx(k,j)= gvdwx(k,j) + gg(k)
1862 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1863 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1864 c! this acts on Calpha
1865 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1866 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1868 c! sc_grad is done, now we will compute
1877 c! d1 = dhead(1, 1, itypi, itypj)
1878 c! d2 = dhead(2, 1, itypi, itypj)
1879 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1880 c! & +dhead(1,ii,itypi,itypj))**2))
1881 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1882 c! & +dhead(2,jj,itypi,itypj))**2))
1883 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1884 c! END OF ENERGY DEBUG
1885 c*************************************************************
1886 DO istate = 1, nstate(itypi,itypj)
1887 c*************************************************************
1888 IF (istate.ne.1) THEN
1889 IF (istate.lt.3) THEN
1895 d1 = dhead(1,ii,itypi,itypj)
1896 d2 = dhead(2,jj,itypi,itypj)
1898 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
1899 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
1900 Rhead_distance(k) = chead(k,2) - chead(k,1)
1902 c! pitagoras (root of sum of squares)
1904 & (Rhead_distance(1)*Rhead_distance(1))
1905 & + (Rhead_distance(2)*Rhead_distance(2))
1906 & + (Rhead_distance(3)*Rhead_distance(3)))
1908 Rhead_sq = Rhead * Rhead
1910 c! R1 - distance between head of ith side chain and tail of jth sidechain
1911 c! R2 - distance between head of jth side chain and tail of ith sidechain
1915 c! Calculate head-to-tail distances
1916 R1=R1+(ctail(k,2)-chead(k,1))**2
1917 R2=R2+(chead(k,2)-ctail(k,1))**2
1924 c! write (*,*) "istate = ", istate
1925 c! write (*,*) "ii = ", ii
1926 c! write (*,*) "jj = ", jj
1927 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1928 c! & +dhead(1,ii,itypi,itypj))**2))
1929 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1930 c! & +dhead(2,jj,itypi,itypj))**2))
1931 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1932 c! Rhead_sq = Rhead * Rhead
1933 c! write (*,*) "d1 = ",d1
1934 c! write (*,*) "d2 = ",d2
1935 c! write (*,*) "R1 = ",R1
1936 c! write (*,*) "R2 = ",R2
1937 c! write (*,*) "Rhead = ",Rhead
1938 c! END OF ENERGY DEBUG
1940 c!-------------------------------------------------------------------
1941 c! Coulomb electrostatic interaction
1942 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
1944 c! write (*,*) "Ecl = ", Ecl
1945 c! derivative of Ecl is Gcl...
1946 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
1951 c!-------------------------------------------------------------------
1952 c! Generalised Born Solvent Polarization
1953 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1954 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1955 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1957 c! write (*,*) "a1*a2 = ", a12sq
1958 c! write (*,*) "Rhead = ", Rhead
1959 c! write (*,*) "Rhead_sq = ", Rhead_sq
1960 c! write (*,*) "ee = ", ee
1961 c! write (*,*) "Fgb = ", Fgb
1962 c! write (*,*) "fac = ", eps_inout_fac
1963 c! write (*,*) "Qij = ", Qij
1964 c! write (*,*) "Egb = ", Egb
1965 c! Derivative of Egb is Ggb...
1966 c! dFGBdR is used by Quad's later...
1967 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1968 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1970 dGGBdR = dGGBdFGB * dFGBdR
1972 c!-------------------------------------------------------------------
1973 c! Fisocav - isotropic cavity creation term
1975 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1976 bot = (1.0d0 + al4 * pom**12.0d0)
1980 c! write (*,*) "pom = ",pom
1981 c! write (*,*) "al1 = ",al1
1982 c! write (*,*) "al2 = ",al2
1983 c! write (*,*) "al3 = ",al3
1984 c! write (*,*) "al4 = ",al4
1985 c! write (*,*) "top = ",top
1986 c! write (*,*) "bot = ",bot
1987 c! write (*,*) "Fisocav = ", Fisocav
1989 c! Derivative of Fisocav is GCV...
1990 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1991 dbot = 12.0d0 * al4 * pom ** 11.0d0
1992 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1994 c!-------------------------------------------------------------------
1995 c! Polarization energy
1997 MomoFac1 = (1.0d0 - chi1 * sqom2)
1998 MomoFac2 = (1.0d0 - chi2 * sqom1)
1999 RR1 = ( R1 * R1 ) / MomoFac1
2000 RR2 = ( R2 * R2 ) / MomoFac2
2001 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2002 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
2003 fgb1 = sqrt( RR1 + a12sq * ee1 )
2004 fgb2 = sqrt( RR2 + a12sq * ee2 )
2005 epol = 332.0d0 * eps_inout_fac * (
2006 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
2008 c! derivative of Epol is Gpol...
2009 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2011 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2013 dFGBdR1 = ( (R1 / MomoFac1)
2014 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2015 & / ( 2.0d0 * fgb1 )
2016 dFGBdR2 = ( (R2 / MomoFac2)
2017 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2018 & / ( 2.0d0 * fgb2 )
2019 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2020 & * ( 2.0d0 - 0.5d0 * ee1) )
2021 & / ( 2.0d0 * fgb1 )
2022 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2023 & * ( 2.0d0 - 0.5d0 * ee2) )
2024 & / ( 2.0d0 * fgb2 )
2025 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2027 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2029 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2031 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2033 c!-------------------------------------------------------------------
2035 pom = (pis / Rhead)**6.0d0
2036 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2038 c! derivative of Elj is Glj
2039 dGLJdR = 4.0d0 * eps_head
2040 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2041 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2043 c!-------------------------------------------------------------------
2045 IF (Wqd.ne.0.0d0) THEN
2046 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
2047 & - 37.5d0 * ( sqom1 + sqom2 )
2048 & + 157.5d0 * ( sqom1 * sqom2 )
2049 & - 45.0d0 * om1*om2*om12
2050 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
2053 c! derivative of Equad...
2054 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
2057 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
2058 c! dQUADdOM1 = 0.0d0
2060 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
2061 c! dQUADdOM2 = 0.0d0
2063 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
2064 c! dQUADdOM12 = 0.0d0
2069 c!-------------------------------------------------------------------
2070 c! Return the results
2072 eom1 = dPOLdOM1 + dQUADdOM1
2073 eom2 = dPOLdOM2 + dQUADdOM2
2075 c! now some magical transformations to project gradient into
2076 c! three cartesian vectors
2078 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
2079 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
2080 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
2084 erhead(k) = Rhead_distance(k)/Rhead
2085 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2086 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2088 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2089 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2090 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2091 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2092 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2093 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2094 facd1 = d1 * vbld_inv(i+nres)
2095 facd2 = d2 * vbld_inv(j+nres)
2096 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2097 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2098 c! Throw the results into gheadtail which holds gradients
2099 c! for each micro-state
2101 hawk = erhead_tail(k,1) +
2102 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
2103 condor = erhead_tail(k,2) +
2104 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
2106 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2107 c! this acts on hydrophobic center of interaction
2108 gheadtail(k,1,1) = gheadtail(k,1,1)
2113 & - dPOLdR2 * (erhead_tail(k,2)
2114 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2118 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2119 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2121 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2122 c! this acts on hydrophobic center of interaction
2123 gheadtail(k,2,1) = gheadtail(k,2,1)
2127 & + dPOLdR1 * (erhead_tail(k,1)
2128 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2129 & + dPOLdR2 * condor
2133 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2134 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2136 c! this acts on Calpha
2137 gheadtail(k,3,1) = gheadtail(k,3,1)
2138 & - dGCLdR * erhead(k)
2139 & - dGGBdR * erhead(k)
2140 & - dGCVdR * erhead(k)
2141 & - dPOLdR1 * erhead_tail(k,1)
2142 & - dPOLdR2 * erhead_tail(k,2)
2143 & - dGLJdR * erhead(k)
2144 & - dQUADdR * erhead(k)
2147 c! this acts on Calpha
2148 gheadtail(k,4,1) = gheadtail(k,4,1)
2149 & + dGCLdR * erhead(k)
2150 & + dGGBdR * erhead(k)
2151 & + dGCVdR * erhead(k)
2152 & + dPOLdR1 * erhead_tail(k,1)
2153 & + dPOLdR2 * erhead_tail(k,2)
2154 & + dGLJdR * erhead(k)
2155 & + dQUADdR * erhead(k)
2158 c! write(*,*) "ECL = ", Ecl
2159 c! write(*,*) "Egb = ", Egb
2160 c! write(*,*) "Epol = ", Epol
2161 c! write(*,*) "Fisocav = ", Fisocav
2162 c! write(*,*) "Elj = ", Elj
2163 c! write(*,*) "Equad = ", Equad
2164 c! write(*,*) "wstate = ", wstate(istate,itypi,itypj)
2165 c! write(*,*) "eheadtail = ", eheadtail
2166 c! write(*,*) "TROLL = ", dexp(-betaT * ener(istate))
2167 c! write(*,*) "dGCLdR = ", dGCLdR
2168 c! write(*,*) "dGGBdR = ", dGGBdR
2169 c! write(*,*) "dGCVdR = ", dGCVdR
2170 c! write(*,*) "dPOLdR1 = ", dPOLdR1
2171 c! write(*,*) "dPOLdR2 = ", dPOLdR2
2172 c! write(*,*) "dGLJdR = ", dGLJdR
2173 c! write(*,*) "dQUADdR = ", dQUADdR
2174 c! write(*,*) "tuna(",k,") = ", tuna(k)
2175 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
2176 eheadtail = eheadtail
2177 & + wstate(istate, itypi, itypj)
2178 & * dexp(-betaT * ener(istate))
2179 c! foreach cartesian dimension
2181 c! foreach of two gvdwx and gvdwc
2183 gheadtail(k,l,2) = gheadtail(k,l,2)
2184 & + wstate( istate, itypi, itypj )
2185 & * dexp(-betaT * ener(istate))
2186 & * gheadtail(k,l,1)
2187 gheadtail(k,l,1) = 0.0d0
2191 c! Here ended the gigantic DO istate = 1, 4, which starts
2192 c! at the beggining of the subroutine
2196 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
2198 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
2199 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
2200 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
2201 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
2203 gheadtail(k,l,1) = 0.0d0
2204 gheadtail(k,l,2) = 0.0d0
2207 eheadtail = (-dlog(eheadtail)) / betaT
2214 END SUBROUTINE energy_quad
2215 c!-------------------------------------------------------------------
2216 SUBROUTINE eqn(Epol)
2218 INCLUDE 'DIMENSIONS'
2219 INCLUDE 'DIMENSIONS.ZSCOPT'
2220 INCLUDE 'COMMON.CALC'
2221 INCLUDE 'COMMON.CHAIN'
2222 INCLUDE 'COMMON.CONTROL'
2223 INCLUDE 'COMMON.DERIV'
2224 INCLUDE 'COMMON.EMP'
2225 INCLUDE 'COMMON.GEO'
2226 INCLUDE 'COMMON.INTERACT'
2227 INCLUDE 'COMMON.IOUNITS'
2228 INCLUDE 'COMMON.LOCAL'
2229 INCLUDE 'COMMON.NAMES'
2230 INCLUDE 'COMMON.VAR'
2231 double precision scalar, facd4, federmaus
2232 alphapol1 = alphapol(itypi,itypj)
2233 c! R1 - distance between head of ith side chain and tail of jth sidechain
2236 c! Calculate head-to-tail distances
2237 R1=R1+(ctail(k,2)-chead(k,1))**2
2242 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2243 c! & +dhead(1,1,itypi,itypj))**2))
2244 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2245 c! & +dhead(2,1,itypi,itypj))**2))
2246 c--------------------------------------------------------------------
2247 c Polarization energy
2249 MomoFac1 = (1.0d0 - chi1 * sqom2)
2250 RR1 = R1 * R1 / MomoFac1
2251 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2252 fgb1 = sqrt( RR1 + a12sq * ee1)
2253 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2255 c!------------------------------------------------------------------
2256 c! derivative of Epol is Gpol...
2257 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2259 dFGBdR1 = ( (R1 / MomoFac1)
2260 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2261 & / ( 2.0d0 * fgb1 )
2262 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2263 & * (2.0d0 - 0.5d0 * ee1) )
2265 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2268 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2270 c!-------------------------------------------------------------------
2271 c! Return the results
2272 c! (see comments in Eqq)
2274 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2276 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2277 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2278 facd1 = d1 * vbld_inv(i+nres)
2279 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2282 hawk = (erhead_tail(k,1) +
2283 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2285 gvdwx(k,i) = gvdwx(k,i)
2287 gvdwx(k,j) = gvdwx(k,j)
2288 & + dPOLdR1 * (erhead_tail(k,1)
2289 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2291 gvdwc(k,i) = gvdwc(k,i)
2292 & - dPOLdR1 * erhead_tail(k,1)
2293 gvdwc(k,j) = gvdwc(k,j)
2294 & + dPOLdR1 * erhead_tail(k,1)
2301 c!-------------------------------------------------------------------
2305 SUBROUTINE enq(Epol)
2307 INCLUDE 'DIMENSIONS'
2308 INCLUDE 'DIMENSIONS.ZSCOPT'
2309 INCLUDE 'COMMON.CALC'
2310 INCLUDE 'COMMON.CHAIN'
2311 INCLUDE 'COMMON.CONTROL'
2312 INCLUDE 'COMMON.DERIV'
2313 INCLUDE 'COMMON.EMP'
2314 INCLUDE 'COMMON.GEO'
2315 INCLUDE 'COMMON.INTERACT'
2316 INCLUDE 'COMMON.IOUNITS'
2317 INCLUDE 'COMMON.LOCAL'
2318 INCLUDE 'COMMON.NAMES'
2319 INCLUDE 'COMMON.VAR'
2320 double precision scalar, facd3, adler
2321 alphapol2 = alphapol(itypj,itypi)
2322 c! R2 - distance between head of jth side chain and tail of ith sidechain
2325 c! Calculate head-to-tail distances
2326 R2=R2+(chead(k,2)-ctail(k,1))**2
2331 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2332 c! & +dhead(1,1,itypi,itypj))**2))
2333 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2334 c! & +dhead(2,1,itypi,itypj))**2))
2335 c------------------------------------------------------------------------
2336 c Polarization energy
2337 MomoFac2 = (1.0d0 - chi2 * sqom1)
2338 RR2 = R2 * R2 / MomoFac2
2339 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2340 fgb2 = sqrt(RR2 + a12sq * ee2)
2341 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2343 c!-------------------------------------------------------------------
2344 c! derivative of Epol is Gpol...
2345 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2347 dFGBdR2 = ( (R2 / MomoFac2)
2348 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2350 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2351 & * (2.0d0 - 0.5d0 * ee2) )
2353 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2355 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2358 c!-------------------------------------------------------------------
2359 c! Return the results
2360 c! (See comments in Eqq)
2362 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2364 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2365 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2366 facd2 = d2 * vbld_inv(j+nres)
2367 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2369 condor = (erhead_tail(k,2)
2370 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2372 gvdwx(k,i) = gvdwx(k,i)
2373 & - dPOLdR2 * (erhead_tail(k,2)
2374 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2375 gvdwx(k,j) = gvdwx(k,j)
2376 & + dPOLdR2 * condor
2378 gvdwc(k,i) = gvdwc(k,i)
2379 & - dPOLdR2 * erhead_tail(k,2)
2380 gvdwc(k,j) = gvdwc(k,j)
2381 & + dPOLdR2 * erhead_tail(k,2)
2388 c!-------------------------------------------------------------------
2391 SUBROUTINE eqd(Ecl,Elj,Epol)
2393 INCLUDE 'DIMENSIONS'
2394 INCLUDE 'DIMENSIONS.ZSCOPT'
2395 INCLUDE 'COMMON.CALC'
2396 INCLUDE 'COMMON.CHAIN'
2397 INCLUDE 'COMMON.CONTROL'
2398 INCLUDE 'COMMON.DERIV'
2399 INCLUDE 'COMMON.EMP'
2400 INCLUDE 'COMMON.GEO'
2401 INCLUDE 'COMMON.INTERACT'
2402 INCLUDE 'COMMON.IOUNITS'
2403 INCLUDE 'COMMON.LOCAL'
2404 INCLUDE 'COMMON.NAMES'
2405 INCLUDE 'COMMON.VAR'
2406 double precision scalar, facd4, federmaus
2407 alphapol1 = alphapol(itypi,itypj)
2408 w1 = wqdip(1,itypi,itypj)
2409 w2 = wqdip(2,itypi,itypj)
2410 pis = sig0head(itypi,itypj)
2411 eps_head = epshead(itypi,itypj)
2412 c!-------------------------------------------------------------------
2413 c! R1 - distance between head of ith side chain and tail of jth sidechain
2416 c! Calculate head-to-tail distances
2417 R1=R1+(ctail(k,2)-chead(k,1))**2
2422 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2423 c! & +dhead(1,1,itypi,itypj))**2))
2424 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2425 c! & +dhead(2,1,itypi,itypj))**2))
2427 c!-------------------------------------------------------------------
2429 sparrow = w1 * Qi * om1
2430 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2431 Ecl = sparrow / Rhead**2.0d0
2432 & - hawk / Rhead**4.0d0
2433 c!-------------------------------------------------------------------
2434 c! derivative of ecl is Gcl
2436 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2437 & + 4.0d0 * hawk / Rhead**5.0d0
2439 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2441 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2442 c--------------------------------------------------------------------
2443 c Polarization energy
2445 MomoFac1 = (1.0d0 - chi1 * sqom2)
2446 RR1 = R1 * R1 / MomoFac1
2447 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2448 fgb1 = sqrt( RR1 + a12sq * ee1)
2449 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2451 c!------------------------------------------------------------------
2452 c! derivative of Epol is Gpol...
2453 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2455 dFGBdR1 = ( (R1 / MomoFac1)
2456 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2457 & / ( 2.0d0 * fgb1 )
2458 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2459 & * (2.0d0 - 0.5d0 * ee1) )
2461 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2464 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2466 c!-------------------------------------------------------------------
2468 pom = (pis / Rhead)**6.0d0
2469 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2470 c! derivative of Elj is Glj
2471 dGLJdR = 4.0d0 * eps_head
2472 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2473 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2474 c!-------------------------------------------------------------------
2475 c! Return the results
2477 erhead(k) = Rhead_distance(k)/Rhead
2478 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2481 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2482 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2483 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2484 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2485 facd1 = d1 * vbld_inv(i+nres)
2486 facd2 = d2 * vbld_inv(j+nres)
2487 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2490 hawk = (erhead_tail(k,1) +
2491 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2493 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2494 gvdwx(k,i) = gvdwx(k,i)
2499 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2500 gvdwx(k,j) = gvdwx(k,j)
2502 & + dPOLdR1 * (erhead_tail(k,1)
2503 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2507 gvdwc(k,i) = gvdwc(k,i)
2508 & - dGCLdR * erhead(k)
2509 & - dPOLdR1 * erhead_tail(k,1)
2510 & - dGLJdR * erhead(k)
2512 gvdwc(k,j) = gvdwc(k,j)
2513 & + dGCLdR * erhead(k)
2514 & + dPOLdR1 * erhead_tail(k,1)
2515 & + dGLJdR * erhead(k)
2522 c!-------------------------------------------------------------------
2525 SUBROUTINE edq(Ecl,Elj,Epol)
2527 INCLUDE 'DIMENSIONS'
2528 INCLUDE 'DIMENSIONS.ZSCOPT'
2529 INCLUDE 'COMMON.CALC'
2530 INCLUDE 'COMMON.CHAIN'
2531 INCLUDE 'COMMON.CONTROL'
2532 INCLUDE 'COMMON.DERIV'
2533 INCLUDE 'COMMON.EMP'
2534 INCLUDE 'COMMON.GEO'
2535 INCLUDE 'COMMON.INTERACT'
2536 INCLUDE 'COMMON.IOUNITS'
2537 INCLUDE 'COMMON.LOCAL'
2538 INCLUDE 'COMMON.NAMES'
2539 INCLUDE 'COMMON.VAR'
2540 double precision scalar, facd3, adler
2541 alphapol2 = alphapol(itypj,itypi)
2542 w1 = wqdip(1,itypi,itypj)
2543 w2 = wqdip(2,itypi,itypj)
2544 pis = sig0head(itypi,itypj)
2545 eps_head = epshead(itypi,itypj)
2546 c!-------------------------------------------------------------------
2547 c! R2 - distance between head of jth side chain and tail of ith sidechain
2550 c! Calculate head-to-tail distances
2551 R2=R2+(chead(k,2)-ctail(k,1))**2
2556 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2557 c! & +dhead(1,1,itypi,itypj))**2))
2558 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2559 c! & +dhead(2,1,itypi,itypj))**2))
2562 c!-------------------------------------------------------------------
2564 sparrow = w1 * Qi * om1
2565 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2566 ECL = sparrow / Rhead**2.0d0
2567 & - hawk / Rhead**4.0d0
2568 c!-------------------------------------------------------------------
2569 c! derivative of ecl is Gcl
2571 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2572 & + 4.0d0 * hawk / Rhead**5.0d0
2574 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2576 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2577 c--------------------------------------------------------------------
2578 c Polarization energy
2580 MomoFac2 = (1.0d0 - chi2 * sqom1)
2581 RR2 = R2 * R2 / MomoFac2
2582 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2583 fgb2 = sqrt(RR2 + a12sq * ee2)
2584 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2586 c! derivative of Epol is Gpol...
2587 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2589 dFGBdR2 = ( (R2 / MomoFac2)
2590 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2592 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2593 & * (2.0d0 - 0.5d0 * ee2) )
2595 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2597 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2600 c!-------------------------------------------------------------------
2602 pom = (pis / Rhead)**6.0d0
2603 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2604 c! derivative of Elj is Glj
2605 dGLJdR = 4.0d0 * eps_head
2606 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2607 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2608 c!-------------------------------------------------------------------
2609 c! Return the results
2610 c! (see comments in Eqq)
2612 erhead(k) = Rhead_distance(k)/Rhead
2613 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2615 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2616 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2617 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2618 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2619 facd1 = d1 * vbld_inv(i+nres)
2620 facd2 = d2 * vbld_inv(j+nres)
2621 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2624 condor = (erhead_tail(k,2)
2625 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2627 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2628 gvdwx(k,i) = gvdwx(k,i)
2630 & - dPOLdR2 * (erhead_tail(k,2)
2631 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2634 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2635 gvdwx(k,j) = gvdwx(k,j)
2637 & + dPOLdR2 * condor
2641 gvdwc(k,i) = gvdwc(k,i)
2642 & - dGCLdR * erhead(k)
2643 & - dPOLdR2 * erhead_tail(k,2)
2644 & - dGLJdR * erhead(k)
2646 gvdwc(k,j) = gvdwc(k,j)
2647 & + dGCLdR * erhead(k)
2648 & + dPOLdR2 * erhead_tail(k,2)
2649 & + dGLJdR * erhead(k)
2656 C--------------------------------------------------------------------
2661 INCLUDE 'DIMENSIONS'
2662 INCLUDE 'DIMENSIONS.ZSCOPT'
2663 INCLUDE 'COMMON.CALC'
2664 INCLUDE 'COMMON.CHAIN'
2665 INCLUDE 'COMMON.CONTROL'
2666 INCLUDE 'COMMON.DERIV'
2667 INCLUDE 'COMMON.EMP'
2668 INCLUDE 'COMMON.GEO'
2669 INCLUDE 'COMMON.INTERACT'
2670 INCLUDE 'COMMON.IOUNITS'
2671 INCLUDE 'COMMON.LOCAL'
2672 INCLUDE 'COMMON.NAMES'
2673 INCLUDE 'COMMON.VAR'
2674 double precision scalar
2675 c! csig = sigiso(itypi,itypj)
2676 w1 = wqdip(1,itypi,itypj)
2677 w2 = wqdip(2,itypi,itypj)
2678 c!-------------------------------------------------------------------
2680 fac = (om12 - 3.0d0 * om1 * om2)
2681 c1 = (w1 / (Rhead**3.0d0)) * fac
2682 c2 = (w2 / Rhead ** 6.0d0)
2683 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2685 c! write (*,*) "w1 = ", w1
2686 c! write (*,*) "w2 = ", w2
2687 c! write (*,*) "om1 = ", om1
2688 c! write (*,*) "om2 = ", om2
2689 c! write (*,*) "om12 = ", om12
2690 c! write (*,*) "fac = ", fac
2691 c! write (*,*) "c1 = ", c1
2692 c! write (*,*) "c2 = ", c2
2693 c! write (*,*) "Ecl = ", Ecl
2694 c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
2695 c! write (*,*) "c2_2 = ",
2696 c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2697 c!-------------------------------------------------------------------
2698 c! dervative of ECL is GCL...
2700 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
2701 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
2702 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
2705 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
2706 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2707 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
2710 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
2711 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2712 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
2715 c1 = w1 / (Rhead ** 3.0d0)
2716 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
2718 c!-------------------------------------------------------------------
2719 c! Return the results
2720 c! (see comments in Eqq)
2722 erhead(k) = Rhead_distance(k)/Rhead
2724 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2725 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2726 facd1 = d1 * vbld_inv(i+nres)
2727 facd2 = d2 * vbld_inv(j+nres)
2730 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2731 gvdwx(k,i) = gvdwx(k,i)
2733 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2734 gvdwx(k,j) = gvdwx(k,j)
2737 gvdwc(k,i) = gvdwc(k,i)
2738 & - dGCLdR * erhead(k)
2739 gvdwc(k,j) = gvdwc(k,j)
2740 & + dGCLdR * erhead(k)
2746 c!-------------------------------------------------------------------
2749 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
2752 INCLUDE 'DIMENSIONS'
2753 INCLUDE 'DIMENSIONS.ZSCOPT'
2754 c! itypi, itypj, i, j, k, l, chead,
2755 INCLUDE 'COMMON.CALC'
2757 INCLUDE 'COMMON.CHAIN'
2759 INCLUDE 'COMMON.DERIV'
2760 c! electrostatic gradients-specific variables
2761 INCLUDE 'COMMON.EMP'
2762 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
2763 INCLUDE 'COMMON.INTERACT'
2765 c INCLUDE 'COMMON.MD'
2766 c! io for debug, disable it in final builds
2767 INCLUDE 'COMMON.IOUNITS'
2768 double precision Rb /1.987D-3/
2769 c!-------------------------------------------------------------------
2772 c! what amino acid is the aminoacid j'th?
2774 c! 1/(Gas Constant * Thermostate temperature) = BetaT
2775 c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
2777 c! BetaT = 1.0d0 / (t_bath * Rb)
2778 BetaT = 1.0d0 / (298.0d0 * Rb)
2780 sig0ij = sigma( itypi,itypj )
2781 chi1 = chi( itypi, itypj )
2782 chi2 = chi( itypj, itypi )
2784 chip1 = chipp( itypi, itypj )
2785 chip2 = chipp( itypj, itypi )
2786 chip12 = chip1 * chip2
2787 c! not used by momo potential, but needed by sc_angular which is shared
2788 c! by all energy_potential subroutines
2792 c! location, location, location
2793 xj = c( 1, nres+j ) - xi
2794 yj = c( 2, nres+j ) - yi
2795 zj = c( 3, nres+j ) - zi
2796 dxj = dc_norm( 1, nres+j )
2797 dyj = dc_norm( 2, nres+j )
2798 dzj = dc_norm( 3, nres+j )
2799 c! distance from center of chain(?) to polar/charged head
2800 c! write (*,*) "istate = ", 1
2801 c! write (*,*) "ii = ", 1
2802 c! write (*,*) "jj = ", 1
2803 d1 = dhead(1, 1, itypi, itypj)
2804 d2 = dhead(2, 1, itypi, itypj)
2806 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
2807 c! a12sq = a12sq * a12sq
2808 c! charge of amino acid itypi is...
2813 chis1 = chis(itypi,itypj)
2814 chis2 = chis(itypj,itypi)
2815 chis12 = chis1 * chis2
2816 sig1 = sigmap1(itypi,itypj)
2817 sig2 = sigmap2(itypi,itypj)
2818 c! write (*,*) "sig1 = ", sig1
2819 c! write (*,*) "sig2 = ", sig2
2820 c! alpha factors from Fcav/Gcav
2821 b1 = alphasur(1,itypi,itypj)
2822 b2 = alphasur(2,itypi,itypj)
2823 b3 = alphasur(3,itypi,itypj)
2824 b4 = alphasur(4,itypi,itypj)
2825 c! used to determine whether we want to do quadrupole calculations
2826 wqd = wquad(itypi, itypj)
2828 eps_in = epsintab(itypi,itypj)
2829 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
2830 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
2831 c!-------------------------------------------------------------------
2832 c! tail location and distance calculations
2835 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
2836 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
2838 c! tail distances will be themselves usefull elswhere
2839 c1 (in Gcav, for example)
2840 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
2841 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
2842 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
2844 & (Rtail_distance(1)*Rtail_distance(1))
2845 & + (Rtail_distance(2)*Rtail_distance(2))
2846 & + (Rtail_distance(3)*Rtail_distance(3)))
2847 c!-------------------------------------------------------------------
2848 c! Calculate location and distance between polar heads
2849 c! distance between heads
2850 c! for each one of our three dimensional space...
2852 c! location of polar head is computed by taking hydrophobic centre
2853 c! and moving by a d1 * dc_norm vector
2854 c! see unres publications for very informative images
2855 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
2856 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
2858 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
2859 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
2860 Rhead_distance(k) = chead(k,2) - chead(k,1)
2862 c! pitagoras (root of sum of squares)
2864 & (Rhead_distance(1)*Rhead_distance(1))
2865 & + (Rhead_distance(2)*Rhead_distance(2))
2866 & + (Rhead_distance(3)*Rhead_distance(3)))
2867 c!-------------------------------------------------------------------
2868 c! zero everything that should be zero'ed
2881 END SUBROUTINE elgrad_init
2884 C-----------------------------------------------------------------------------
2885 subroutine sc_angular
2886 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2887 C om12. Called by ebp, egb, and egbv.
2889 include 'COMMON.CALC'
2893 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2894 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2895 om12=dxi*dxj+dyi*dyj+dzi*dzj
2897 C Calculate eps1(om12) and its derivative in om12
2898 faceps1=1.0D0-om12*chiom12
2899 faceps1_inv=1.0D0/faceps1
2900 eps1=dsqrt(faceps1_inv)
2901 C Following variable is eps1*deps1/dom12
2902 eps1_om12=faceps1_inv*chiom12
2903 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2908 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2909 sigsq=1.0D0-facsig*faceps1_inv
2910 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2911 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2912 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2913 C Calculate eps2 and its derivatives in om1, om2, and om12.
2916 chipom12=chip12*om12
2917 facp=1.0D0-om12*chipom12
2919 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2920 C Following variable is the square root of eps2
2921 eps2rt=1.0D0-facp1*facp_inv
2922 C Following three variables are the derivatives of the square root of eps
2923 C in om1, om2, and om12.
2924 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2925 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2926 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2927 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2928 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2929 C Calculate whole angle-dependent part of epsilon and contributions
2930 C to its derivatives
2933 C----------------------------------------------------------------------------
2935 implicit real*8 (a-h,o-z)
2936 include 'DIMENSIONS'
2937 include 'DIMENSIONS.ZSCOPT'
2938 include 'COMMON.CHAIN'
2939 include 'COMMON.DERIV'
2940 include 'COMMON.CALC'
2941 double precision dcosom1(3),dcosom2(3)
2942 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2943 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2944 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2945 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2947 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2948 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2951 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2954 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2955 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2956 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2957 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2958 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2959 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2962 C Calculate the components of the gradient in DC and X
2966 gvdwc(l,k)=gvdwc(l,k)+gg(l)
2971 c------------------------------------------------------------------------------
2972 subroutine vec_and_deriv
2973 implicit real*8 (a-h,o-z)
2974 include 'DIMENSIONS'
2975 include 'DIMENSIONS.ZSCOPT'
2976 include 'COMMON.IOUNITS'
2977 include 'COMMON.GEO'
2978 include 'COMMON.VAR'
2979 include 'COMMON.LOCAL'
2980 include 'COMMON.CHAIN'
2981 include 'COMMON.VECTORS'
2982 include 'COMMON.DERIV'
2983 include 'COMMON.INTERACT'
2984 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2985 C Compute the local reference systems. For reference system (i), the
2986 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2987 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2989 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
2990 if (i.eq.nres-1) then
2991 C Case of the last full residue
2992 C Compute the Z-axis
2993 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2994 costh=dcos(pi-theta(nres))
2995 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3000 C Compute the derivatives of uz
3002 uzder(2,1,1)=-dc_norm(3,i-1)
3003 uzder(3,1,1)= dc_norm(2,i-1)
3004 uzder(1,2,1)= dc_norm(3,i-1)
3006 uzder(3,2,1)=-dc_norm(1,i-1)
3007 uzder(1,3,1)=-dc_norm(2,i-1)
3008 uzder(2,3,1)= dc_norm(1,i-1)
3011 uzder(2,1,2)= dc_norm(3,i)
3012 uzder(3,1,2)=-dc_norm(2,i)
3013 uzder(1,2,2)=-dc_norm(3,i)
3015 uzder(3,2,2)= dc_norm(1,i)
3016 uzder(1,3,2)= dc_norm(2,i)
3017 uzder(2,3,2)=-dc_norm(1,i)
3020 C Compute the Y-axis
3023 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
3026 C Compute the derivatives of uy
3029 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
3030 & -dc_norm(k,i)*dc_norm(j,i-1)
3031 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3033 uyder(j,j,1)=uyder(j,j,1)-costh
3034 uyder(j,j,2)=1.0d0+uyder(j,j,2)
3039 uygrad(l,k,j,i)=uyder(l,k,j)
3040 uzgrad(l,k,j,i)=uzder(l,k,j)
3044 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3045 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3046 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3047 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3051 C Compute the Z-axis
3052 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
3053 costh=dcos(pi-theta(i+2))
3054 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3059 C Compute the derivatives of uz
3061 uzder(2,1,1)=-dc_norm(3,i+1)
3062 uzder(3,1,1)= dc_norm(2,i+1)
3063 uzder(1,2,1)= dc_norm(3,i+1)
3065 uzder(3,2,1)=-dc_norm(1,i+1)
3066 uzder(1,3,1)=-dc_norm(2,i+1)
3067 uzder(2,3,1)= dc_norm(1,i+1)
3070 uzder(2,1,2)= dc_norm(3,i)
3071 uzder(3,1,2)=-dc_norm(2,i)
3072 uzder(1,2,2)=-dc_norm(3,i)
3074 uzder(3,2,2)= dc_norm(1,i)
3075 uzder(1,3,2)= dc_norm(2,i)
3076 uzder(2,3,2)=-dc_norm(1,i)
3079 C Compute the Y-axis
3082 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3085 C Compute the derivatives of uy
3088 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
3089 & -dc_norm(k,i)*dc_norm(j,i+1)
3090 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3092 uyder(j,j,1)=uyder(j,j,1)-costh
3093 uyder(j,j,2)=1.0d0+uyder(j,j,2)
3098 uygrad(l,k,j,i)=uyder(l,k,j)
3099 uzgrad(l,k,j,i)=uzder(l,k,j)
3103 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3104 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3105 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3106 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3112 vbld_inv_temp(1)=vbld_inv(i+1)
3113 if (i.lt.nres-1) then
3114 vbld_inv_temp(2)=vbld_inv(i+2)
3116 vbld_inv_temp(2)=vbld_inv(i)
3121 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
3122 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
3130 c------------------------------------------------------------------------------
3131 subroutine set_matrices
3132 implicit real*8 (a-h,o-z)
3133 include 'DIMENSIONS'
3137 integer status(MPI_STATUS_SIZE)
3139 include 'DIMENSIONS.ZSCOPT'
3140 include 'COMMON.IOUNITS'
3141 include 'COMMON.GEO'
3142 include 'COMMON.VAR'
3143 include 'COMMON.LOCAL'
3144 include 'COMMON.CHAIN'
3145 include 'COMMON.DERIV'
3146 include 'COMMON.INTERACT'
3147 include 'COMMON.CONTACTS'
3148 include 'COMMON.TORSION'
3149 include 'COMMON.VECTORS'
3150 include 'COMMON.FFIELD'
3151 double precision auxvec(2),auxmat(2,2)
3153 C Compute the virtual-bond-torsional-angle dependent quantities needed
3154 C to calculate the el-loc multibody terms of various order.
3156 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
3158 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3159 iti = itype2loc(itype(i-2))
3163 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3164 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3165 iti1 = itype2loc(itype(i-1))
3170 cost1=dcos(theta(i-1))
3171 sint1=dsin(theta(i-1))
3173 sint1cub=sint1sq*sint1
3174 sint1cost1=2*sint1*cost1
3176 write (iout,*) "bnew1",i,iti
3177 write (iout,*) (bnew1(k,1,iti),k=1,3)
3178 write (iout,*) (bnew1(k,2,iti),k=1,3)
3179 write (iout,*) "bnew2",i,iti
3180 write (iout,*) (bnew2(k,1,iti),k=1,3)
3181 write (iout,*) (bnew2(k,2,iti),k=1,3)
3184 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
3186 gtb1(k,i-2)=cost1*b1k-sint1sq*
3187 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
3188 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
3190 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
3191 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
3194 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
3195 cc(1,k,i-2)=sint1sq*aux
3196 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
3197 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
3198 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
3199 dd(1,k,i-2)=sint1sq*aux
3200 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
3201 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
3203 cc(2,1,i-2)=cc(1,2,i-2)
3204 cc(2,2,i-2)=-cc(1,1,i-2)
3205 gtcc(2,1,i-2)=gtcc(1,2,i-2)
3206 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
3207 dd(2,1,i-2)=dd(1,2,i-2)
3208 dd(2,2,i-2)=-dd(1,1,i-2)
3209 gtdd(2,1,i-2)=gtdd(1,2,i-2)
3210 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
3213 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
3214 EE(l,k,i-2)=sint1sq*aux
3216 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
3219 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
3220 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
3221 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
3222 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
3224 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
3225 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
3226 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
3228 c b1tilde(1,i-2)=b1(1,i-2)
3229 c b1tilde(2,i-2)=-b1(2,i-2)
3230 c b2tilde(1,i-2)=b2(1,i-2)
3231 c b2tilde(2,i-2)=-b2(2,i-2)
3233 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
3234 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
3235 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
3236 write (iout,*) 'theta=', theta(i-1)
3239 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3240 iti = itype2loc(itype(i-2))
3244 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3245 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3246 iti1 = itype2loc(itype(i-1))
3256 CC(k,l,i-2)=ccold(k,l,iti)
3257 DD(k,l,i-2)=ddold(k,l,iti)
3258 EE(k,l,i-2)=eeold(k,l,iti)
3262 b1tilde(1,i-2)= b1(1,i-2)
3263 b1tilde(2,i-2)=-b1(2,i-2)
3264 b2tilde(1,i-2)= b2(1,i-2)
3265 b2tilde(2,i-2)=-b2(2,i-2)
3267 Ctilde(1,1,i-2)= CC(1,1,i-2)
3268 Ctilde(1,2,i-2)= CC(1,2,i-2)
3269 Ctilde(2,1,i-2)=-CC(2,1,i-2)
3270 Ctilde(2,2,i-2)=-CC(2,2,i-2)
3272 Dtilde(1,1,i-2)= DD(1,1,i-2)
3273 Dtilde(1,2,i-2)= DD(1,2,i-2)
3274 Dtilde(2,1,i-2)=-DD(2,1,i-2)
3275 Dtilde(2,2,i-2)=-DD(2,2,i-2)
3276 c write(iout,*) "i",i," iti",iti
3277 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
3278 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
3281 if (i .lt. nres+1) then
3318 if (i .gt. 3 .and. i .lt. nres+1) then
3319 obrot_der(1,i-2)=-sin1
3320 obrot_der(2,i-2)= cos1
3321 Ugder(1,1,i-2)= sin1
3322 Ugder(1,2,i-2)=-cos1
3323 Ugder(2,1,i-2)=-cos1
3324 Ugder(2,2,i-2)=-sin1
3327 obrot2_der(1,i-2)=-dwasin2
3328 obrot2_der(2,i-2)= dwacos2
3329 Ug2der(1,1,i-2)= dwasin2
3330 Ug2der(1,2,i-2)=-dwacos2
3331 Ug2der(2,1,i-2)=-dwacos2
3332 Ug2der(2,2,i-2)=-dwasin2
3334 obrot_der(1,i-2)=0.0d0
3335 obrot_der(2,i-2)=0.0d0
3336 Ugder(1,1,i-2)=0.0d0
3337 Ugder(1,2,i-2)=0.0d0
3338 Ugder(2,1,i-2)=0.0d0
3339 Ugder(2,2,i-2)=0.0d0
3340 obrot2_der(1,i-2)=0.0d0
3341 obrot2_der(2,i-2)=0.0d0
3342 Ug2der(1,1,i-2)=0.0d0
3343 Ug2der(1,2,i-2)=0.0d0
3344 Ug2der(2,1,i-2)=0.0d0
3345 Ug2der(2,2,i-2)=0.0d0
3347 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3348 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3349 iti = itype2loc(itype(i-2))
3353 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3354 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3355 iti1 = itype2loc(itype(i-1))
3359 cd write (iout,*) '*******i',i,' iti1',iti
3360 cd write (iout,*) 'b1',b1(:,iti)
3361 cd write (iout,*) 'b2',b2(:,iti)
3362 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3363 c if (i .gt. iatel_s+2) then
3364 if (i .gt. nnt+2) then
3365 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
3367 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
3368 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
3370 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
3371 c & EE(1,2,iti),EE(2,2,i)
3372 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
3373 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
3374 c write(iout,*) "Macierz EUG",
3375 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
3377 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3379 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
3380 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
3381 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3382 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
3383 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
3394 DtUg2(l,k,i-2)=0.0d0
3398 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3399 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3401 muder(k,i-2)=Ub2der(k,i-2)
3403 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3404 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3405 if (itype(i-1).le.ntyp) then
3406 iti1 = itype2loc(itype(i-1))
3414 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3417 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
3418 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
3419 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
3420 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
3421 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
3422 & ((ee(l,k,i-2),l=1,2),k=1,2)
3424 cd write (iout,*) 'mu1',mu1(:,i-2)
3425 cd write (iout,*) 'mu2',mu2(:,i-2)
3426 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3429 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3430 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
3431 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3432 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
3433 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3435 C Vectors and matrices dependent on a single virtual-bond dihedral.
3436 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
3437 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3438 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
3439 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
3440 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
3442 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3443 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
3444 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
3445 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
3449 C Matrices dependent on two consecutive virtual-bond dihedrals.
3450 C The order of matrices is from left to right.
3451 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3454 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3456 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3457 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3459 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3460 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3462 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3463 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3464 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3470 C--------------------------------------------------------------------------
3471 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3473 C This subroutine calculates the average interaction energy and its gradient
3474 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3475 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3476 C The potential depends both on the distance of peptide-group centers and on
3477 C the orientation of the CA-CA virtual bonds.
3479 implicit real*8 (a-h,o-z)
3483 include 'DIMENSIONS'
3484 include 'DIMENSIONS.ZSCOPT'
3485 include 'COMMON.CONTROL'
3486 include 'COMMON.IOUNITS'
3487 include 'COMMON.GEO'
3488 include 'COMMON.VAR'
3489 include 'COMMON.LOCAL'
3490 include 'COMMON.CHAIN'
3491 include 'COMMON.DERIV'
3492 include 'COMMON.INTERACT'
3493 include 'COMMON.CONTACTS'
3494 include 'COMMON.TORSION'
3495 include 'COMMON.VECTORS'
3496 include 'COMMON.FFIELD'
3497 include 'COMMON.TIME1'
3498 include 'COMMON.SPLITELE'
3499 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3500 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3501 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3502 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3503 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3504 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3506 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3508 double precision scal_el /1.0d0/
3510 double precision scal_el /0.5d0/
3513 C 13-go grudnia roku pamietnego...
3514 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3515 & 0.0d0,1.0d0,0.0d0,
3516 & 0.0d0,0.0d0,1.0d0/
3517 cd write(iout,*) 'In EELEC'
3519 cd write(iout,*) 'Type',i
3520 cd write(iout,*) 'B1',B1(:,i)
3521 cd write(iout,*) 'B2',B2(:,i)
3522 cd write(iout,*) 'CC',CC(:,:,i)
3523 cd write(iout,*) 'DD',DD(:,:,i)
3524 cd write(iout,*) 'EE',EE(:,:,i)
3526 cd call check_vecgrad
3528 if (icheckgrad.eq.1) then
3530 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3532 dc_norm(k,i)=dc(k,i)*fac
3534 c write (iout,*) 'i',i,' fac',fac
3537 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3538 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3539 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3540 c call vec_and_deriv
3546 time_mat=time_mat+MPI_Wtime()-time01
3550 cd write (iout,*) 'i=',i
3552 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3555 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3556 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3569 cd print '(a)','Enter EELEC'
3570 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3572 gel_loc_loc(i)=0.0d0
3577 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3579 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3581 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3582 do i=iturn3_start,iturn3_end
3584 C write(iout,*) "tu jest i",i
3585 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3586 C changes suggested by Ana to avoid out of bounds
3587 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
3588 c & .or.((i+4).gt.nres)
3589 c & .or.((i-1).le.0)
3590 C end of changes by Ana
3591 C dobra zmiana wycofana
3592 & .or. itype(i+2).eq.ntyp1
3593 & .or. itype(i+3).eq.ntyp1) cycle
3594 C Adam: Instructions below will switch off existing interactions
3596 c if(itype(i-1).eq.ntyp1)cycle
3598 c if(i.LT.nres-3)then
3599 c if (itype(i+4).eq.ntyp1) cycle
3604 dx_normi=dc_norm(1,i)
3605 dy_normi=dc_norm(2,i)
3606 dz_normi=dc_norm(3,i)
3607 xmedi=c(1,i)+0.5d0*dxi
3608 ymedi=c(2,i)+0.5d0*dyi
3609 zmedi=c(3,i)+0.5d0*dzi
3610 xmedi=mod(xmedi,boxxsize)
3611 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3612 ymedi=mod(ymedi,boxysize)
3613 if (ymedi.lt.0) ymedi=ymedi+boxysize
3614 zmedi=mod(zmedi,boxzsize)
3615 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3617 call eelecij(i,i+2,ees,evdw1,eel_loc)
3618 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3619 num_cont_hb(i)=num_conti
3621 do i=iturn4_start,iturn4_end
3623 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3624 C changes suggested by Ana to avoid out of bounds
3625 c & .or.((i+5).gt.nres)
3626 c & .or.((i-1).le.0)
3627 C end of changes suggested by Ana
3628 & .or. itype(i+3).eq.ntyp1
3629 & .or. itype(i+4).eq.ntyp1
3630 c & .or. itype(i+5).eq.ntyp1
3631 c & .or. itype(i).eq.ntyp1
3632 c & .or. itype(i-1).eq.ntyp1
3637 dx_normi=dc_norm(1,i)
3638 dy_normi=dc_norm(2,i)
3639 dz_normi=dc_norm(3,i)
3640 xmedi=c(1,i)+0.5d0*dxi
3641 ymedi=c(2,i)+0.5d0*dyi
3642 zmedi=c(3,i)+0.5d0*dzi
3643 C Return atom into box, boxxsize is size of box in x dimension
3645 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3646 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3647 C Condition for being inside the proper box
3648 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3649 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3653 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3654 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3655 C Condition for being inside the proper box
3656 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3657 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3661 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3662 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3663 C Condition for being inside the proper box
3664 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3665 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3668 xmedi=mod(xmedi,boxxsize)
3669 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3670 ymedi=mod(ymedi,boxysize)
3671 if (ymedi.lt.0) ymedi=ymedi+boxysize
3672 zmedi=mod(zmedi,boxzsize)
3673 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3675 num_conti=num_cont_hb(i)
3676 c write(iout,*) "JESTEM W PETLI"
3677 call eelecij(i,i+3,ees,evdw1,eel_loc)
3678 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3679 & call eturn4(i,eello_turn4)
3680 num_cont_hb(i)=num_conti
3682 C Loop over all neighbouring boxes
3687 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3690 do i=iatel_s,iatel_e
3693 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3694 C changes suggested by Ana to avoid out of bounds
3695 c & .or.((i+2).gt.nres)
3696 c & .or.((i-1).le.0)
3697 C end of changes by Ana
3698 c & .or. itype(i+2).eq.ntyp1
3699 c & .or. itype(i-1).eq.ntyp1
3704 dx_normi=dc_norm(1,i)
3705 dy_normi=dc_norm(2,i)
3706 dz_normi=dc_norm(3,i)
3707 xmedi=c(1,i)+0.5d0*dxi
3708 ymedi=c(2,i)+0.5d0*dyi
3709 zmedi=c(3,i)+0.5d0*dzi
3710 xmedi=mod(xmedi,boxxsize)
3711 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3712 ymedi=mod(ymedi,boxysize)
3713 if (ymedi.lt.0) ymedi=ymedi+boxysize
3714 zmedi=mod(zmedi,boxzsize)
3715 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3716 C xmedi=xmedi+xshift*boxxsize
3717 C ymedi=ymedi+yshift*boxysize
3718 C zmedi=zmedi+zshift*boxzsize
3720 C Return tom into box, boxxsize is size of box in x dimension
3722 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3723 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3724 C Condition for being inside the proper box
3725 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3726 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3730 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3731 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3732 C Condition for being inside the proper box
3733 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3734 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3738 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3739 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3740 cC Condition for being inside the proper box
3741 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3742 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3746 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3747 num_conti=num_cont_hb(i)
3749 do j=ielstart(i),ielend(i)
3751 C write (iout,*) i,j
3753 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3754 C changes suggested by Ana to avoid out of bounds
3755 c & .or.((j+2).gt.nres)
3756 c & .or.((j-1).le.0)
3757 C end of changes by Ana
3758 c & .or.itype(j+2).eq.ntyp1
3759 c & .or.itype(j-1).eq.ntyp1
3761 call eelecij(i,j,ees,evdw1,eel_loc)
3763 num_cont_hb(i)=num_conti
3769 c write (iout,*) "Number of loop steps in EELEC:",ind
3771 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3772 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3774 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3775 ccc eel_loc=eel_loc+eello_turn3
3776 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3779 C-------------------------------------------------------------------------------
3780 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3781 implicit real*8 (a-h,o-z)
3782 include 'DIMENSIONS'
3783 include 'DIMENSIONS.ZSCOPT'
3787 include 'COMMON.CONTROL'
3788 include 'COMMON.IOUNITS'
3789 include 'COMMON.GEO'
3790 include 'COMMON.VAR'
3791 include 'COMMON.LOCAL'
3792 include 'COMMON.CHAIN'
3793 include 'COMMON.DERIV'
3794 include 'COMMON.INTERACT'
3795 include 'COMMON.CONTACTS'
3796 include 'COMMON.TORSION'
3797 include 'COMMON.VECTORS'
3798 include 'COMMON.FFIELD'
3799 include 'COMMON.TIME1'
3800 include 'COMMON.SPLITELE'
3801 include 'COMMON.SHIELD'
3802 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3803 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3804 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3805 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3806 & gmuij2(4),gmuji2(4)
3807 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3808 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3810 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3812 double precision scal_el /1.0d0/
3814 double precision scal_el /0.5d0/
3817 C 13-go grudnia roku pamietnego...
3818 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3819 & 0.0d0,1.0d0,0.0d0,
3820 & 0.0d0,0.0d0,1.0d0/
3821 integer xshift,yshift,zshift
3822 c time00=MPI_Wtime()
3823 cd write (iout,*) "eelecij",i,j
3827 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3828 aaa=app(iteli,itelj)
3829 bbb=bpp(iteli,itelj)
3830 ael6i=ael6(iteli,itelj)
3831 ael3i=ael3(iteli,itelj)
3835 dx_normj=dc_norm(1,j)
3836 dy_normj=dc_norm(2,j)
3837 dz_normj=dc_norm(3,j)
3838 C xj=c(1,j)+0.5D0*dxj-xmedi
3839 C yj=c(2,j)+0.5D0*dyj-ymedi
3840 C zj=c(3,j)+0.5D0*dzj-zmedi
3845 if (xj.lt.0) xj=xj+boxxsize
3847 if (yj.lt.0) yj=yj+boxysize
3849 if (zj.lt.0) zj=zj+boxzsize
3850 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3851 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3859 xj=xj_safe+xshift*boxxsize
3860 yj=yj_safe+yshift*boxysize
3861 zj=zj_safe+zshift*boxzsize
3862 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3863 if(dist_temp.lt.dist_init) then
3873 if (isubchap.eq.1) then
3882 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3884 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3885 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3886 C Condition for being inside the proper box
3887 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3888 c & (xj.lt.((-0.5d0)*boxxsize))) then
3892 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3893 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3894 C Condition for being inside the proper box
3895 c if ((yj.gt.((0.5d0)*boxysize)).or.
3896 c & (yj.lt.((-0.5d0)*boxysize))) then
3900 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3901 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3902 C Condition for being inside the proper box
3903 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3904 c & (zj.lt.((-0.5d0)*boxzsize))) then
3907 C endif !endPBC condintion
3911 rij=xj*xj+yj*yj+zj*zj
3913 sss=sscale(sqrt(rij))
3914 sssgrad=sscagrad(sqrt(rij))
3915 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
3916 c & " rlamb",rlamb," sss",sss
3917 c if (sss.gt.0.0d0) then
3923 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3924 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3925 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3926 fac=cosa-3.0D0*cosb*cosg
3928 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3929 if (j.eq.i+2) ev1=scal_el*ev1
3934 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3938 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3939 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3940 if (shield_mode.gt.0) then
3943 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3944 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3953 evdw1=evdw1+evdwij*sss
3954 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3955 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3956 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3957 cd & xmedi,ymedi,zmedi,xj,yj,zj
3959 if (energy_dec) then
3960 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
3962 &,iteli,itelj,aaa,evdw1,sss
3963 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
3964 &fac_shield(i),fac_shield(j)
3968 C Calculate contributions to the Cartesian gradient.
3971 facvdw=-6*rrmij*(ev1+evdwij)*sss
3972 facel=-3*rrmij*(el1+eesij)
3979 * Radial derivatives. First process both termini of the fragment (i,j)
3985 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3986 & (shield_mode.gt.0)) then
3988 do ilist=1,ishield_list(i)
3989 iresshield=shield_list(ilist,i)
3991 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3993 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3995 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
3996 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3997 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3998 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3999 C if (iresshield.gt.i) then
4000 C do ishi=i+1,iresshield-1
4001 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4002 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4006 C do ishi=iresshield,i
4007 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4008 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4014 do ilist=1,ishield_list(j)
4015 iresshield=shield_list(ilist,j)
4017 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
4019 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4021 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
4022 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4024 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4025 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4026 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4027 C if (iresshield.gt.j) then
4028 C do ishi=j+1,iresshield-1
4029 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4030 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4034 C do ishi=iresshield,j
4035 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4036 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4043 gshieldc(k,i)=gshieldc(k,i)+
4044 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4045 gshieldc(k,j)=gshieldc(k,j)+
4046 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4047 gshieldc(k,i-1)=gshieldc(k,i-1)+
4048 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4049 gshieldc(k,j-1)=gshieldc(k,j-1)+
4050 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4055 c ghalf=0.5D0*ggg(k)
4056 c gelc(k,i)=gelc(k,i)+ghalf
4057 c gelc(k,j)=gelc(k,j)+ghalf
4059 c 9/28/08 AL Gradient compotents will be summed only at the end
4060 C print *,"before", gelc_long(1,i), gelc_long(1,j)
4062 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4063 C & +grad_shield(k,j)*eesij/fac_shield(j)
4064 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4065 C & +grad_shield(k,i)*eesij/fac_shield(i)
4066 C gelc_long(k,i-1)=gelc_long(k,i-1)
4067 C & +grad_shield(k,i)*eesij/fac_shield(i)
4068 C gelc_long(k,j-1)=gelc_long(k,j-1)
4069 C & +grad_shield(k,j)*eesij/fac_shield(j)
4071 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
4074 * Loop over residues i+1 thru j-1.
4078 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4081 if (sss.gt.0.0) then
4082 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4083 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4084 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4091 c ghalf=0.5D0*ggg(k)
4092 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
4093 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
4095 c 9/28/08 AL Gradient compotents will be summed only at the end
4097 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4098 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4101 * Loop over residues i+1 thru j-1.
4105 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
4111 facvdw=(ev1+evdwij)*sss
4114 fac=-3*rrmij*(facvdw+facvdw+facel)
4119 * Radial derivatives. First process both termini of the fragment (i,j)
4123 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
4125 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
4127 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
4129 c ghalf=0.5D0*ggg(k)
4130 c gelc(k,i)=gelc(k,i)+ghalf
4131 c gelc(k,j)=gelc(k,j)+ghalf
4133 c 9/28/08 AL Gradient compotents will be summed only at the end
4135 gelc_long(k,j)=gelc(k,j)+ggg(k)
4136 gelc_long(k,i)=gelc(k,i)-ggg(k)
4139 * Loop over residues i+1 thru j-1.
4143 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4146 c 9/28/08 AL Gradient compotents will be summed only at the end
4147 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4148 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4149 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4151 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4152 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4160 ecosa=2.0D0*fac3*fac1+fac4
4163 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4164 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4166 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4167 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4169 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4170 cd & (dcosg(k),k=1,3)
4172 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4173 & fac_shield(i)**2*fac_shield(j)**2
4176 c ghalf=0.5D0*ggg(k)
4177 c gelc(k,i)=gelc(k,i)+ghalf
4178 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4179 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4180 c gelc(k,j)=gelc(k,j)+ghalf
4181 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4182 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4186 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4189 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4192 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4193 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4194 & *fac_shield(i)**2*fac_shield(j)**2
4196 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4197 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4198 & *fac_shield(i)**2*fac_shield(j)**2
4199 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4200 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4202 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4207 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4208 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4209 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4211 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4212 C energy of a peptide unit is assumed in the form of a second-order
4213 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4214 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4215 C are computed for EVERY pair of non-contiguous peptide groups.
4218 if (j.lt.nres-1) then
4230 muij(kkk)=mu(k,i)*mu(l,j)
4231 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4234 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4235 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4236 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4237 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4238 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4239 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4245 write (iout,*) 'EELEC: i',i,' j',j
4246 write (iout,*) 'j',j,' j1',j1,' j2',j2
4247 write(iout,*) 'muij',muij
4248 write (iout,*) "uy",uy(:,i)
4249 write (iout,*) "uz",uz(:,j)
4250 write (iout,*) "erij",erij
4252 ury=scalar(uy(1,i),erij)
4253 urz=scalar(uz(1,i),erij)
4254 vry=scalar(uy(1,j),erij)
4255 vrz=scalar(uz(1,j),erij)
4256 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4257 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4258 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4259 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4260 fac=dsqrt(-ael6i)*r3ij
4265 cd write (iout,'(4i5,4f10.5)')
4266 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4267 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4268 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4269 cd & uy(:,j),uz(:,j)
4270 cd write (iout,'(4f10.5)')
4271 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4272 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4273 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4274 cd write (iout,'(9f10.5/)')
4275 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4276 C Derivatives of the elements of A in virtual-bond vectors
4278 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4280 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4281 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4282 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4283 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4284 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4285 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4286 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4287 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4288 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4289 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4290 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4291 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4293 C Compute radial contributions to the gradient
4311 C Add the contributions coming from er
4314 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4315 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4316 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4317 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4320 C Derivatives in DC(i)
4321 cgrad ghalf1=0.5d0*agg(k,1)
4322 cgrad ghalf2=0.5d0*agg(k,2)
4323 cgrad ghalf3=0.5d0*agg(k,3)
4324 cgrad ghalf4=0.5d0*agg(k,4)
4325 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4326 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4327 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4328 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4329 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4330 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4331 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4332 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4333 C Derivatives in DC(i+1)
4334 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4335 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4336 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4337 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4338 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4339 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4340 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4341 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4342 C Derivatives in DC(j)
4343 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4344 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4345 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4346 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4347 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4348 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4349 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4350 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4351 C Derivatives in DC(j+1) or DC(nres-1)
4352 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4353 & -3.0d0*vryg(k,3)*ury)
4354 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4355 & -3.0d0*vrzg(k,3)*ury)
4356 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4357 & -3.0d0*vryg(k,3)*urz)
4358 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4359 & -3.0d0*vrzg(k,3)*urz)
4360 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4362 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4377 aggi(k,l)=-aggi(k,l)
4378 aggi1(k,l)=-aggi1(k,l)
4379 aggj(k,l)=-aggj(k,l)
4380 aggj1(k,l)=-aggj1(k,l)
4384 if (j.lt.nres-1) then
4390 aggi(k,l)=-aggi(k,l)
4391 aggi1(k,l)=-aggi1(k,l)
4392 aggj(k,l)=-aggj(k,l)
4393 aggj1(k,l)=-aggj1(k,l)
4404 aggi(k,l)=-aggi(k,l)
4405 aggi1(k,l)=-aggi1(k,l)
4406 aggj(k,l)=-aggj(k,l)
4407 aggj1(k,l)=-aggj1(k,l)
4412 IF (wel_loc.gt.0.0d0) THEN
4413 C Contribution to the local-electrostatic energy coming from the i-j pair
4414 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4417 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
4419 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
4420 & " wel_loc",wel_loc
4422 if (shield_mode.eq.0) then
4429 eel_loc_ij=eel_loc_ij
4430 & *fac_shield(i)*fac_shield(j)
4431 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4432 & 'eelloc',i,j,eel_loc_ij
4433 c if (eel_loc_ij.ne.0)
4434 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4435 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4437 eel_loc=eel_loc+eel_loc_ij
4438 C Now derivative over eel_loc
4440 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4441 & (shield_mode.gt.0)) then
4444 do ilist=1,ishield_list(i)
4445 iresshield=shield_list(ilist,i)
4447 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4450 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4452 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4453 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4457 do ilist=1,ishield_list(j)
4458 iresshield=shield_list(ilist,j)
4460 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4463 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4465 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4466 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4473 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4474 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4475 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4476 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4477 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4478 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4479 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4480 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4485 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4486 c & ' eel_loc_ij',eel_loc_ij
4487 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4488 C Calculate patrial derivative for theta angle
4490 geel_loc_ij=(a22*gmuij1(1)
4494 & *fac_shield(i)*fac_shield(j)
4495 c write(iout,*) "derivative over thatai"
4496 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4498 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4499 & geel_loc_ij*wel_loc
4500 c write(iout,*) "derivative over thatai-1"
4501 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4508 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4509 & geel_loc_ij*wel_loc
4510 & *fac_shield(i)*fac_shield(j)
4512 c Derivative over j residue
4513 geel_loc_ji=a22*gmuji1(1)
4517 c write(iout,*) "derivative over thataj"
4518 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4521 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4522 & geel_loc_ji*wel_loc
4523 & *fac_shield(i)*fac_shield(j)
4530 c write(iout,*) "derivative over thataj-1"
4531 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4533 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4534 & geel_loc_ji*wel_loc
4535 & *fac_shield(i)*fac_shield(j)
4537 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4539 C Partial derivatives in virtual-bond dihedral angles gamma
4541 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4542 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4543 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4544 & *fac_shield(i)*fac_shield(j)
4546 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4547 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4548 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4549 & *fac_shield(i)*fac_shield(j)
4550 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4552 ggg(l)=(agg(l,1)*muij(1)+
4553 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4554 & *fac_shield(i)*fac_shield(j)
4555 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4556 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4557 cgrad ghalf=0.5d0*ggg(l)
4558 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4559 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4563 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4566 C Remaining derivatives of eello
4568 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4569 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4570 & *fac_shield(i)*fac_shield(j)
4572 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4573 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4574 & *fac_shield(i)*fac_shield(j)
4576 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4577 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4578 & *fac_shield(i)*fac_shield(j)
4580 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4581 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4582 & *fac_shield(i)*fac_shield(j)
4589 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4590 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4591 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4592 & .and. num_conti.le.maxconts) then
4593 c write (iout,*) i,j," entered corr"
4595 C Calculate the contact function. The ith column of the array JCONT will
4596 C contain the numbers of atoms that make contacts with the atom I (of numbers
4597 C greater than I). The arrays FACONT and GACONT will contain the values of
4598 C the contact function and its derivative.
4599 c r0ij=1.02D0*rpp(iteli,itelj)
4600 c r0ij=1.11D0*rpp(iteli,itelj)
4601 r0ij=2.20D0*rpp(iteli,itelj)
4602 c r0ij=1.55D0*rpp(iteli,itelj)
4603 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4604 if (fcont.gt.0.0D0) then
4605 num_conti=num_conti+1
4606 if (num_conti.gt.maxconts) then
4607 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4608 & ' will skip next contacts for this conf.'
4610 jcont_hb(num_conti,i)=j
4611 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4612 cd & " jcont_hb",jcont_hb(num_conti,i)
4613 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4614 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4615 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4617 d_cont(num_conti,i)=rij
4618 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4619 C --- Electrostatic-interaction matrix ---
4620 a_chuj(1,1,num_conti,i)=a22
4621 a_chuj(1,2,num_conti,i)=a23
4622 a_chuj(2,1,num_conti,i)=a32
4623 a_chuj(2,2,num_conti,i)=a33
4624 C --- Gradient of rij
4627 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4634 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4635 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4636 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4637 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4638 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4644 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4645 C Calculate contact energies
4647 wij=cosa-3.0D0*cosb*cosg
4650 c fac3=dsqrt(-ael6i)/r0ij**3
4651 fac3=dsqrt(-ael6i)*r3ij
4652 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4653 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4654 if (ees0tmp.gt.0) then
4655 ees0pij=dsqrt(ees0tmp)
4659 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4660 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4661 if (ees0tmp.gt.0) then
4662 ees0mij=dsqrt(ees0tmp)
4667 if (shield_mode.eq.0) then
4671 ees0plist(num_conti,i)=j
4672 C fac_shield(i)=0.4d0
4673 C fac_shield(j)=0.6d0
4675 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4676 & *fac_shield(i)*fac_shield(j)
4677 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4678 & *fac_shield(i)*fac_shield(j)
4679 C Diagnostics. Comment out or remove after debugging!
4680 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4681 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4682 c ees0m(num_conti,i)=0.0D0
4684 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4685 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4686 C Angular derivatives of the contact function
4688 ees0pij1=fac3/ees0pij
4689 ees0mij1=fac3/ees0mij
4690 fac3p=-3.0D0*fac3*rrmij
4691 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4692 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4694 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4695 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4696 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4697 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4698 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4699 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4700 ecosap=ecosa1+ecosa2
4701 ecosbp=ecosb1+ecosb2
4702 ecosgp=ecosg1+ecosg2
4703 ecosam=ecosa1-ecosa2
4704 ecosbm=ecosb1-ecosb2
4705 ecosgm=ecosg1-ecosg2
4714 facont_hb(num_conti,i)=fcont
4717 fprimcont=fprimcont/rij
4718 cd facont_hb(num_conti,i)=1.0D0
4719 C Following line is for diagnostics.
4722 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4723 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4726 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4727 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4729 gggp(1)=gggp(1)+ees0pijp*xj
4730 gggp(2)=gggp(2)+ees0pijp*yj
4731 gggp(3)=gggp(3)+ees0pijp*zj
4732 gggm(1)=gggm(1)+ees0mijp*xj
4733 gggm(2)=gggm(2)+ees0mijp*yj
4734 gggm(3)=gggm(3)+ees0mijp*zj
4735 C Derivatives due to the contact function
4736 gacont_hbr(1,num_conti,i)=fprimcont*xj
4737 gacont_hbr(2,num_conti,i)=fprimcont*yj
4738 gacont_hbr(3,num_conti,i)=fprimcont*zj
4741 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4742 c following the change of gradient-summation algorithm.
4744 cgrad ghalfp=0.5D0*gggp(k)
4745 cgrad ghalfm=0.5D0*gggm(k)
4746 gacontp_hb1(k,num_conti,i)=!ghalfp
4747 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4748 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4749 & *fac_shield(i)*fac_shield(j)
4751 gacontp_hb2(k,num_conti,i)=!ghalfp
4752 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4753 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4754 & *fac_shield(i)*fac_shield(j)
4756 gacontp_hb3(k,num_conti,i)=gggp(k)
4757 & *fac_shield(i)*fac_shield(j)
4759 gacontm_hb1(k,num_conti,i)=!ghalfm
4760 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4761 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4762 & *fac_shield(i)*fac_shield(j)
4764 gacontm_hb2(k,num_conti,i)=!ghalfm
4765 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4766 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4767 & *fac_shield(i)*fac_shield(j)
4769 gacontm_hb3(k,num_conti,i)=gggm(k)
4770 & *fac_shield(i)*fac_shield(j)
4773 C Diagnostics. Comment out or remove after debugging!
4775 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4776 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4777 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4778 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4779 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4780 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4786 endif ! num_conti.le.maxconts
4790 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4793 ghalf=0.5d0*agg(l,k)
4794 aggi(l,k)=aggi(l,k)+ghalf
4795 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4796 aggj(l,k)=aggj(l,k)+ghalf
4799 if (j.eq.nres-1 .and. i.lt.j-2) then
4802 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4808 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4811 C-----------------------------------------------------------------------------
4812 subroutine eturn3(i,eello_turn3)
4813 C Third- and fourth-order contributions from turns
4814 implicit real*8 (a-h,o-z)
4815 include 'DIMENSIONS'
4816 include 'DIMENSIONS.ZSCOPT'
4817 include 'COMMON.IOUNITS'
4818 include 'COMMON.GEO'
4819 include 'COMMON.VAR'
4820 include 'COMMON.LOCAL'
4821 include 'COMMON.CHAIN'
4822 include 'COMMON.DERIV'
4823 include 'COMMON.INTERACT'
4824 include 'COMMON.CONTACTS'
4825 include 'COMMON.TORSION'
4826 include 'COMMON.VECTORS'
4827 include 'COMMON.FFIELD'
4828 include 'COMMON.CONTROL'
4829 include 'COMMON.SHIELD'
4831 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4832 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4833 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4834 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4835 & auxgmat2(2,2),auxgmatt2(2,2)
4836 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4837 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4838 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4839 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4842 c write (iout,*) "eturn3",i,j,j1,j2
4847 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4849 C Third-order contributions
4856 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4857 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4858 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4859 c auxalary matices for theta gradient
4860 c auxalary matrix for i+1 and constant i+2
4861 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4862 c auxalary matrix for i+2 and constant i+1
4863 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4864 call transpose2(auxmat(1,1),auxmat1(1,1))
4865 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4866 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4867 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4868 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4869 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4870 if (shield_mode.eq.0) then
4877 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4878 & *fac_shield(i)*fac_shield(j)
4879 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
4880 & *fac_shield(i)*fac_shield(j)
4881 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
4885 C Derivatives in theta
4886 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4887 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4888 & *fac_shield(i)*fac_shield(j)
4889 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4890 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4891 & *fac_shield(i)*fac_shield(j)
4894 C Derivatives in shield mode
4895 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4896 & (shield_mode.gt.0)) then
4899 do ilist=1,ishield_list(i)
4900 iresshield=shield_list(ilist,i)
4902 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4904 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4906 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4907 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4911 do ilist=1,ishield_list(j)
4912 iresshield=shield_list(ilist,j)
4914 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4916 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4918 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4919 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4926 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
4927 & grad_shield(k,i)*eello_t3/fac_shield(i)
4928 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
4929 & grad_shield(k,j)*eello_t3/fac_shield(j)
4930 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
4931 & grad_shield(k,i)*eello_t3/fac_shield(i)
4932 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
4933 & grad_shield(k,j)*eello_t3/fac_shield(j)
4937 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4938 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4939 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4940 cd & ' eello_turn3_num',4*eello_turn3_num
4941 C Derivatives in gamma(i)
4942 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4943 call transpose2(auxmat2(1,1),auxmat3(1,1))
4944 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4945 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4946 & *fac_shield(i)*fac_shield(j)
4947 C Derivatives in gamma(i+1)
4948 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4949 call transpose2(auxmat2(1,1),auxmat3(1,1))
4950 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4951 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4952 & +0.5d0*(pizda(1,1)+pizda(2,2))
4953 & *fac_shield(i)*fac_shield(j)
4954 C Cartesian derivatives
4956 c ghalf1=0.5d0*agg(l,1)
4957 c ghalf2=0.5d0*agg(l,2)
4958 c ghalf3=0.5d0*agg(l,3)
4959 c ghalf4=0.5d0*agg(l,4)
4960 a_temp(1,1)=aggi(l,1)!+ghalf1
4961 a_temp(1,2)=aggi(l,2)!+ghalf2
4962 a_temp(2,1)=aggi(l,3)!+ghalf3
4963 a_temp(2,2)=aggi(l,4)!+ghalf4
4964 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4965 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4966 & +0.5d0*(pizda(1,1)+pizda(2,2))
4967 & *fac_shield(i)*fac_shield(j)
4969 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4970 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4971 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4972 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4973 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4974 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4975 & +0.5d0*(pizda(1,1)+pizda(2,2))
4976 & *fac_shield(i)*fac_shield(j)
4977 a_temp(1,1)=aggj(l,1)!+ghalf1
4978 a_temp(1,2)=aggj(l,2)!+ghalf2
4979 a_temp(2,1)=aggj(l,3)!+ghalf3
4980 a_temp(2,2)=aggj(l,4)!+ghalf4
4981 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4982 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4983 & +0.5d0*(pizda(1,1)+pizda(2,2))
4984 & *fac_shield(i)*fac_shield(j)
4985 a_temp(1,1)=aggj1(l,1)
4986 a_temp(1,2)=aggj1(l,2)
4987 a_temp(2,1)=aggj1(l,3)
4988 a_temp(2,2)=aggj1(l,4)
4989 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4990 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4991 & +0.5d0*(pizda(1,1)+pizda(2,2))
4992 & *fac_shield(i)*fac_shield(j)
4999 C-------------------------------------------------------------------------------
5000 subroutine eturn4(i,eello_turn4)
5001 C Third- and fourth-order contributions from turns
5002 implicit real*8 (a-h,o-z)
5003 include 'DIMENSIONS'
5004 include 'DIMENSIONS.ZSCOPT'
5005 include 'COMMON.IOUNITS'
5006 include 'COMMON.GEO'
5007 include 'COMMON.VAR'
5008 include 'COMMON.LOCAL'
5009 include 'COMMON.CHAIN'
5010 include 'COMMON.DERIV'
5011 include 'COMMON.INTERACT'
5012 include 'COMMON.CONTACTS'
5013 include 'COMMON.TORSION'
5014 include 'COMMON.VECTORS'
5015 include 'COMMON.FFIELD'
5016 include 'COMMON.CONTROL'
5017 include 'COMMON.SHIELD'
5019 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5020 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5021 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
5022 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
5023 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
5024 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
5025 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
5026 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5027 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5028 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5029 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5032 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5034 C Fourth-order contributions
5042 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5043 cd call checkint_turn4(i,a_temp,eello_turn4_num)
5044 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5045 c write(iout,*)"WCHODZE W PROGRAM"
5050 iti1=itype2loc(itype(i+1))
5051 iti2=itype2loc(itype(i+2))
5052 iti3=itype2loc(itype(i+3))
5053 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5054 call transpose2(EUg(1,1,i+1),e1t(1,1))
5055 call transpose2(Eug(1,1,i+2),e2t(1,1))
5056 call transpose2(Eug(1,1,i+3),e3t(1,1))
5057 C Ematrix derivative in theta
5058 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
5059 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
5060 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
5061 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5062 c eta1 in derivative theta
5063 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
5064 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5065 c auxgvec is derivative of Ub2 so i+3 theta
5066 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
5067 c auxalary matrix of E i+1
5068 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
5071 s1=scalar2(b1(1,i+2),auxvec(1))
5072 c derivative of theta i+2 with constant i+3
5073 gs23=scalar2(gtb1(1,i+2),auxvec(1))
5074 c derivative of theta i+2 with constant i+2
5075 gs32=scalar2(b1(1,i+2),auxgvec(1))
5076 c derivative of E matix in theta of i+1
5077 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
5079 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5080 c ea31 in derivative theta
5081 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
5082 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5083 c auxilary matrix auxgvec of Ub2 with constant E matirx
5084 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
5085 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
5086 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
5090 s2=scalar2(b1(1,i+1),auxvec(1))
5091 c derivative of theta i+1 with constant i+3
5092 gs13=scalar2(gtb1(1,i+1),auxvec(1))
5093 c derivative of theta i+2 with constant i+1
5094 gs21=scalar2(b1(1,i+1),auxgvec(1))
5095 c derivative of theta i+3 with constant i+1
5096 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
5097 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
5099 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5100 c two derivatives over diffetent matrices
5101 c gtae3e2 is derivative over i+3
5102 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
5103 c ae3gte2 is derivative over i+2
5104 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5105 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5106 c three possible derivative over theta E matices
5108 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5110 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5112 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5113 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5115 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5116 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5117 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5118 if (shield_mode.eq.0) then
5125 eello_turn4=eello_turn4-(s1+s2+s3)
5126 & *fac_shield(i)*fac_shield(j)
5127 eello_t4=-(s1+s2+s3)
5128 & *fac_shield(i)*fac_shield(j)
5129 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
5130 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
5131 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
5132 C Now derivative over shield:
5133 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5134 & (shield_mode.gt.0)) then
5137 do ilist=1,ishield_list(i)
5138 iresshield=shield_list(ilist,i)
5140 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5142 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5144 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5145 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5149 do ilist=1,ishield_list(j)
5150 iresshield=shield_list(ilist,j)
5152 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5154 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5156 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5157 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5164 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
5165 & grad_shield(k,i)*eello_t4/fac_shield(i)
5166 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
5167 & grad_shield(k,j)*eello_t4/fac_shield(j)
5168 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
5169 & grad_shield(k,i)*eello_t4/fac_shield(i)
5170 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
5171 & grad_shield(k,j)*eello_t4/fac_shield(j)
5174 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5175 cd & ' eello_turn4_num',8*eello_turn4_num
5177 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5178 & -(gs13+gsE13+gsEE1)*wturn4
5179 & *fac_shield(i)*fac_shield(j)
5180 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
5181 & -(gs23+gs21+gsEE2)*wturn4
5182 & *fac_shield(i)*fac_shield(j)
5184 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
5185 & -(gs32+gsE31+gsEE3)*wturn4
5186 & *fac_shield(i)*fac_shield(j)
5188 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5191 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5192 & 'eturn4',i,j,-(s1+s2+s3)
5193 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5194 c & ' eello_turn4_num',8*eello_turn4_num
5195 C Derivatives in gamma(i)
5196 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5197 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5198 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5199 s1=scalar2(b1(1,i+2),auxvec(1))
5200 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5201 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5202 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5203 & *fac_shield(i)*fac_shield(j)
5204 C Derivatives in gamma(i+1)
5205 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5206 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5207 s2=scalar2(b1(1,i+1),auxvec(1))
5208 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5209 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5210 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5211 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5212 & *fac_shield(i)*fac_shield(j)
5213 C Derivatives in gamma(i+2)
5214 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5215 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5216 s1=scalar2(b1(1,i+2),auxvec(1))
5217 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5218 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5219 s2=scalar2(b1(1,i+1),auxvec(1))
5220 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5221 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5222 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5223 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5224 & *fac_shield(i)*fac_shield(j)
5226 C Cartesian derivatives
5227 C Derivatives of this turn contributions in DC(i+2)
5228 if (j.lt.nres-1) then
5230 a_temp(1,1)=agg(l,1)
5231 a_temp(1,2)=agg(l,2)
5232 a_temp(2,1)=agg(l,3)
5233 a_temp(2,2)=agg(l,4)
5234 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5235 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5236 s1=scalar2(b1(1,i+2),auxvec(1))
5237 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5238 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5239 s2=scalar2(b1(1,i+1),auxvec(1))
5240 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5241 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5242 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5244 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5245 & *fac_shield(i)*fac_shield(j)
5248 C Remaining derivatives of this turn contribution
5250 a_temp(1,1)=aggi(l,1)
5251 a_temp(1,2)=aggi(l,2)
5252 a_temp(2,1)=aggi(l,3)
5253 a_temp(2,2)=aggi(l,4)
5254 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5255 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5256 s1=scalar2(b1(1,i+2),auxvec(1))
5257 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5258 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5259 s2=scalar2(b1(1,i+1),auxvec(1))
5260 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5261 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5262 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5263 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5264 & *fac_shield(i)*fac_shield(j)
5265 a_temp(1,1)=aggi1(l,1)
5266 a_temp(1,2)=aggi1(l,2)
5267 a_temp(2,1)=aggi1(l,3)
5268 a_temp(2,2)=aggi1(l,4)
5269 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5270 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5271 s1=scalar2(b1(1,i+2),auxvec(1))
5272 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5273 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5274 s2=scalar2(b1(1,i+1),auxvec(1))
5275 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5276 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5277 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5278 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5279 & *fac_shield(i)*fac_shield(j)
5280 a_temp(1,1)=aggj(l,1)
5281 a_temp(1,2)=aggj(l,2)
5282 a_temp(2,1)=aggj(l,3)
5283 a_temp(2,2)=aggj(l,4)
5284 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5285 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5286 s1=scalar2(b1(1,i+2),auxvec(1))
5287 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5288 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5289 s2=scalar2(b1(1,i+1),auxvec(1))
5290 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5291 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5292 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5293 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5294 & *fac_shield(i)*fac_shield(j)
5295 a_temp(1,1)=aggj1(l,1)
5296 a_temp(1,2)=aggj1(l,2)
5297 a_temp(2,1)=aggj1(l,3)
5298 a_temp(2,2)=aggj1(l,4)
5299 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5300 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5301 s1=scalar2(b1(1,i+2),auxvec(1))
5302 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5303 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5304 s2=scalar2(b1(1,i+1),auxvec(1))
5305 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5306 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5307 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5308 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5309 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5310 & *fac_shield(i)*fac_shield(j)
5317 C-----------------------------------------------------------------------------
5318 subroutine vecpr(u,v,w)
5319 implicit real*8(a-h,o-z)
5320 dimension u(3),v(3),w(3)
5321 w(1)=u(2)*v(3)-u(3)*v(2)
5322 w(2)=-u(1)*v(3)+u(3)*v(1)
5323 w(3)=u(1)*v(2)-u(2)*v(1)
5326 C-----------------------------------------------------------------------------
5327 subroutine unormderiv(u,ugrad,unorm,ungrad)
5328 C This subroutine computes the derivatives of a normalized vector u, given
5329 C the derivatives computed without normalization conditions, ugrad. Returns
5332 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5333 double precision vec(3)
5334 double precision scalar
5336 c write (2,*) 'ugrad',ugrad
5339 vec(i)=scalar(ugrad(1,i),u(1))
5341 c write (2,*) 'vec',vec
5344 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5347 c write (2,*) 'ungrad',ungrad
5350 C-----------------------------------------------------------------------------
5351 subroutine escp(evdw2,evdw2_14)
5353 C This subroutine calculates the excluded-volume interaction energy between
5354 C peptide-group centers and side chains and its gradient in virtual-bond and
5355 C side-chain vectors.
5357 implicit real*8 (a-h,o-z)
5358 include 'DIMENSIONS'
5359 include 'DIMENSIONS.ZSCOPT'
5360 include 'COMMON.GEO'
5361 include 'COMMON.VAR'
5362 include 'COMMON.LOCAL'
5363 include 'COMMON.CHAIN'
5364 include 'COMMON.DERIV'
5365 include 'COMMON.INTERACT'
5366 include 'COMMON.FFIELD'
5367 include 'COMMON.IOUNITS'
5371 cd print '(a)','Enter ESCP'
5372 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
5373 c & ' scal14',scal14
5374 do i=iatscp_s,iatscp_e
5375 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5377 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
5378 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
5379 if (iteli.eq.0) goto 1225
5380 xi=0.5D0*(c(1,i)+c(1,i+1))
5381 yi=0.5D0*(c(2,i)+c(2,i+1))
5382 zi=0.5D0*(c(3,i)+c(3,i+1))
5383 C Returning the ith atom to box
5385 if (xi.lt.0) xi=xi+boxxsize
5387 if (yi.lt.0) yi=yi+boxysize
5389 if (zi.lt.0) zi=zi+boxzsize
5390 do iint=1,nscp_gr(i)
5392 do j=iscpstart(i,iint),iscpend(i,iint)
5393 itypj=iabs(itype(j))
5394 if (itypj.eq.ntyp1) cycle
5395 C Uncomment following three lines for SC-p interactions
5399 C Uncomment following three lines for Ca-p interactions
5403 C returning the jth atom to box
5405 if (xj.lt.0) xj=xj+boxxsize
5407 if (yj.lt.0) yj=yj+boxysize
5409 if (zj.lt.0) zj=zj+boxzsize
5410 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5415 C Finding the closest jth atom
5419 xj=xj_safe+xshift*boxxsize
5420 yj=yj_safe+yshift*boxysize
5421 zj=zj_safe+zshift*boxzsize
5422 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5423 if(dist_temp.lt.dist_init) then
5433 if (subchap.eq.1) then
5442 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5443 C sss is scaling function for smoothing the cutoff gradient otherwise
5444 C the gradient would not be continuouse
5445 sss=sscale(1.0d0/(dsqrt(rrij)))
5446 if (sss.le.0.0d0) cycle
5447 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5449 e1=fac*fac*aad(itypj,iteli)
5450 e2=fac*bad(itypj,iteli)
5451 if (iabs(j-i) .le. 2) then
5454 evdw2_14=evdw2_14+(e1+e2)*sss
5457 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5458 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5459 c & bad(itypj,iteli)
5460 evdw2=evdw2+evdwij*sss
5463 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5465 fac=-(evdwij+e1)*rrij*sss
5466 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5471 cd write (iout,*) 'j<i'
5472 C Uncomment following three lines for SC-p interactions
5474 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5477 cd write (iout,*) 'j>i'
5480 C Uncomment following line for SC-p interactions
5481 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5485 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5489 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5490 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5493 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5503 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5504 gradx_scp(j,i)=expon*gradx_scp(j,i)
5507 C******************************************************************************
5511 C To save time the factor EXPON has been extracted from ALL components
5512 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5515 C******************************************************************************
5518 C--------------------------------------------------------------------------
5519 subroutine edis(ehpb)
5521 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5523 implicit real*8 (a-h,o-z)
5524 include 'DIMENSIONS'
5525 include 'DIMENSIONS.ZSCOPT'
5526 include 'COMMON.SBRIDGE'
5527 include 'COMMON.CHAIN'
5528 include 'COMMON.DERIV'
5529 include 'COMMON.VAR'
5530 include 'COMMON.INTERACT'
5531 include 'COMMON.CONTROL'
5532 include 'COMMON.IOUNITS'
5535 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
5536 cd print *,'link_start=',link_start,' link_end=',link_end
5537 C write(iout,*) link_end, "link_end"
5538 if (link_end.eq.0) return
5539 do i=link_start,link_end
5540 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5541 C CA-CA distance used in regularization of structure.
5544 C iii and jjj point to the residues for which the distance is assigned.
5545 if (ii.gt.nres) then
5552 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5553 C distance and angle dependent SS bond potential.
5554 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5555 C & iabs(itype(jjj)).eq.1) then
5556 C write(iout,*) constr_dist,"const"
5557 if (.not.dyn_ss .and. i.le.nss) then
5558 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5559 & iabs(itype(jjj)).eq.1) then
5560 call ssbond_ene(iii,jjj,eij)
5563 else if (ii.gt.nres .and. jj.gt.nres) then
5564 c Restraints from contact prediction
5566 if (constr_dist.eq.11) then
5567 C ehpb=ehpb+fordepth(i)**4.0d0
5568 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5569 ehpb=ehpb+fordepth(i)**4.0d0
5570 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5571 fac=fordepth(i)**4.0d0
5572 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5573 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5574 C & ehpb,fordepth(i),dd
5575 C write(iout,*) ehpb,"atu?"
5577 C fac=fordepth(i)**4.0d0
5578 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5580 if (dhpb1(i).gt.0.0d0) then
5581 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5582 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5583 c write (iout,*) "beta nmr",
5584 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5588 C Get the force constant corresponding to this distance.
5590 C Calculate the contribution to energy.
5591 ehpb=ehpb+waga*rdis*rdis
5592 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5594 C Evaluate gradient.
5597 endif !end dhpb1(i).gt.0
5598 endif !end const_dist=11
5600 ggg(j)=fac*(c(j,jj)-c(j,ii))
5603 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5604 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5607 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5608 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5611 C write(iout,*) "before"
5613 C write(iout,*) "after",dd
5614 if (constr_dist.eq.11) then
5615 ehpb=ehpb+fordepth(i)**4.0d0
5616 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5617 fac=fordepth(i)**4.0d0
5618 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5619 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
5620 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
5621 C print *,ehpb,"tu?"
5622 C write(iout,*) ehpb,"btu?",
5623 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
5624 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5625 C & ehpb,fordepth(i),dd
5627 if (dhpb1(i).gt.0.0d0) then
5628 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5629 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5630 c write (iout,*) "alph nmr",
5631 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5634 C Get the force constant corresponding to this distance.
5636 C Calculate the contribution to energy.
5637 ehpb=ehpb+waga*rdis*rdis
5638 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5640 C Evaluate gradient.
5647 ggg(j)=fac*(c(j,jj)-c(j,ii))
5649 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5650 C If this is a SC-SC distance, we need to calculate the contributions to the
5651 C Cartesian gradient in the SC vectors (ghpbx).
5654 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5655 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5660 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5665 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5668 C--------------------------------------------------------------------------
5669 subroutine ssbond_ene(i,j,eij)
5671 C Calculate the distance and angle dependent SS-bond potential energy
5672 C using a free-energy function derived based on RHF/6-31G** ab initio
5673 C calculations of diethyl disulfide.
5675 C A. Liwo and U. Kozlowska, 11/24/03
5677 implicit real*8 (a-h,o-z)
5678 include 'DIMENSIONS'
5679 include 'DIMENSIONS.ZSCOPT'
5680 include 'COMMON.SBRIDGE'
5681 include 'COMMON.CHAIN'
5682 include 'COMMON.DERIV'
5683 include 'COMMON.LOCAL'
5684 include 'COMMON.INTERACT'
5685 include 'COMMON.VAR'
5686 include 'COMMON.IOUNITS'
5687 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5688 itypi=iabs(itype(i))
5692 dxi=dc_norm(1,nres+i)
5693 dyi=dc_norm(2,nres+i)
5694 dzi=dc_norm(3,nres+i)
5695 dsci_inv=dsc_inv(itypi)
5696 itypj=iabs(itype(j))
5697 dscj_inv=dsc_inv(itypj)
5701 dxj=dc_norm(1,nres+j)
5702 dyj=dc_norm(2,nres+j)
5703 dzj=dc_norm(3,nres+j)
5704 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5709 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5710 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5711 om12=dxi*dxj+dyi*dyj+dzi*dzj
5713 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5714 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5720 deltat12=om2-om1+2.0d0
5722 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5723 & +akct*deltad*deltat12
5724 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
5725 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5726 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5727 c & " deltat12",deltat12," eij",eij
5728 ed=2*akcm*deltad+akct*deltat12
5730 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5731 eom1=-2*akth*deltat1-pom1-om2*pom2
5732 eom2= 2*akth*deltat2+pom1-om1*pom2
5735 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5738 ghpbx(k,i)=ghpbx(k,i)-gg(k)
5739 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
5740 ghpbx(k,j)=ghpbx(k,j)+gg(k)
5741 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
5744 C Calculate the components of the gradient in DC and X
5748 ghpbc(l,k)=ghpbc(l,k)+gg(l)
5753 C--------------------------------------------------------------------------
5754 subroutine ebond(estr)
5756 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5758 implicit real*8 (a-h,o-z)
5759 include 'DIMENSIONS'
5760 include 'DIMENSIONS.ZSCOPT'
5761 include 'COMMON.LOCAL'
5762 include 'COMMON.GEO'
5763 include 'COMMON.INTERACT'
5764 include 'COMMON.DERIV'
5765 include 'COMMON.VAR'
5766 include 'COMMON.CHAIN'
5767 include 'COMMON.IOUNITS'
5768 include 'COMMON.NAMES'
5769 include 'COMMON.FFIELD'
5770 include 'COMMON.CONTROL'
5771 double precision u(3),ud(3)
5774 c write (iout,*) "distchainmax",distchainmax
5776 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5777 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5779 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5780 C & *dc(j,i-1)/vbld(i)
5782 C if (energy_dec) write(iout,*)
5783 C & "estr1",i,vbld(i),distchainmax,
5784 C & gnmr1(vbld(i),-1.0d0,distchainmax)
5786 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5787 diff = vbld(i)-vbldpDUM
5788 write(iout,*) "dumm_bond",i,diff
5790 diff = vbld(i)-vbldp0
5791 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
5793 write (iout,'(a7,i5,4f7.3)')
5794 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5797 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5801 estr=0.5d0*AKP*estr+estr1
5803 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5807 if (iti.ne.10 .and. iti.ne.ntyp1) then
5810 diff=vbld(i+nres)-vbldsc0(1,iti)
5812 & "estr_sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5813 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5814 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5816 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5820 diff=vbld(i+nres)-vbldsc0(j,iti)
5821 ud(j)=aksc(j,iti)*diff
5822 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5836 uprod2=uprod2*u(k)*u(k)
5840 usumsqder=usumsqder+ud(j)*uprod2
5842 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
5843 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
5844 estr=estr+uprod/usum
5846 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5854 C--------------------------------------------------------------------------
5855 subroutine ebend(etheta,ethetacnstr)
5857 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5858 C angles gamma and its derivatives in consecutive thetas and gammas.
5860 implicit real*8 (a-h,o-z)
5861 include 'DIMENSIONS'
5862 include 'DIMENSIONS.ZSCOPT'
5863 include 'COMMON.LOCAL'
5864 include 'COMMON.GEO'
5865 include 'COMMON.INTERACT'
5866 include 'COMMON.DERIV'
5867 include 'COMMON.VAR'
5868 include 'COMMON.CHAIN'
5869 include 'COMMON.IOUNITS'
5870 include 'COMMON.NAMES'
5871 include 'COMMON.FFIELD'
5872 include 'COMMON.TORCNSTR'
5873 common /calcthet/ term1,term2,termm,diffak,ratak,
5874 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5875 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5876 double precision y(2),z(2)
5878 c time11=dexp(-2*time)
5881 c write (iout,*) "nres",nres
5882 c write (*,'(a,i2)') 'EBEND ICG=',icg
5883 c write (iout,*) ithet_start,ithet_end
5884 do i=ithet_start,ithet_end
5885 C if (itype(i-1).eq.ntyp1) cycle
5887 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5888 & .or.itype(i).eq.ntyp1) cycle
5889 C Zero the energy function and its derivative at 0 or pi.
5890 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5892 ichir1=isign(1,itype(i-2))
5893 ichir2=isign(1,itype(i))
5894 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5895 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5896 if (itype(i-1).eq.10) then
5897 itype1=isign(10,itype(i-2))
5898 ichir11=isign(1,itype(i-2))
5899 ichir12=isign(1,itype(i-2))
5900 itype2=isign(10,itype(i))
5901 ichir21=isign(1,itype(i))
5902 ichir22=isign(1,itype(i))
5909 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5913 c call proc_proc(phii,icrc)
5914 if (icrc.eq.1) phii=150.0
5925 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5929 c call proc_proc(phii1,icrc)
5930 if (icrc.eq.1) phii1=150.0
5942 C Calculate the "mean" value of theta from the part of the distribution
5943 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5944 C In following comments this theta will be referred to as t_c.
5945 thet_pred_mean=0.0d0
5947 athetk=athet(k,it,ichir1,ichir2)
5948 bthetk=bthet(k,it,ichir1,ichir2)
5950 athetk=athet(k,itype1,ichir11,ichir12)
5951 bthetk=bthet(k,itype2,ichir21,ichir22)
5953 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5955 c write (iout,*) "thet_pred_mean",thet_pred_mean
5956 dthett=thet_pred_mean*ssd
5957 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5958 c write (iout,*) "thet_pred_mean",thet_pred_mean
5959 C Derivatives of the "mean" values in gamma1 and gamma2.
5960 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5961 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5962 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5963 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5965 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5966 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5967 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5968 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5970 if (theta(i).gt.pi-delta) then
5971 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5973 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5974 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5975 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5977 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5979 else if (theta(i).lt.delta) then
5980 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5981 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5982 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5984 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5985 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5988 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5991 etheta=etheta+ethetai
5992 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5993 c & 'ebend',i,ethetai,theta(i),itype(i)
5994 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5995 c & rad2deg*phii,rad2deg*phii1,ethetai
5996 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5997 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5998 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
6002 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6003 do i=1,ntheta_constr
6004 itheta=itheta_constr(i)
6005 thetiii=theta(itheta)
6006 difi=pinorm(thetiii-theta_constr0(i))
6007 if (difi.gt.theta_drange(i)) then
6008 difi=difi-theta_drange(i)
6009 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6010 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6011 & +for_thet_constr(i)*difi**3
6012 else if (difi.lt.-drange(i)) then
6014 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6015 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6016 & +for_thet_constr(i)*difi**3
6020 C if (energy_dec) then
6021 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6022 C & i,itheta,rad2deg*thetiii,
6023 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6024 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6025 C & gloc(itheta+nphi-2,icg)
6028 C Ufff.... We've done all this!!!
6031 C---------------------------------------------------------------------------
6032 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6034 implicit real*8 (a-h,o-z)
6035 include 'DIMENSIONS'
6036 include 'COMMON.LOCAL'
6037 include 'COMMON.IOUNITS'
6038 common /calcthet/ term1,term2,termm,diffak,ratak,
6039 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6040 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6041 C Calculate the contributions to both Gaussian lobes.
6042 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6043 C The "polynomial part" of the "standard deviation" of this part of
6047 sig=sig*thet_pred_mean+polthet(j,it)
6049 C Derivative of the "interior part" of the "standard deviation of the"
6050 C gamma-dependent Gaussian lobe in t_c.
6051 sigtc=3*polthet(3,it)
6053 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6056 C Set the parameters of both Gaussian lobes of the distribution.
6057 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6058 fac=sig*sig+sigc0(it)
6061 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6062 sigsqtc=-4.0D0*sigcsq*sigtc
6063 c print *,i,sig,sigtc,sigsqtc
6064 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6065 sigtc=-sigtc/(fac*fac)
6066 C Following variable is sigma(t_c)**(-2)
6067 sigcsq=sigcsq*sigcsq
6069 sig0inv=1.0D0/sig0i**2
6070 delthec=thetai-thet_pred_mean
6071 delthe0=thetai-theta0i
6072 term1=-0.5D0*sigcsq*delthec*delthec
6073 term2=-0.5D0*sig0inv*delthe0*delthe0
6074 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6075 C NaNs in taking the logarithm. We extract the largest exponent which is added
6076 C to the energy (this being the log of the distribution) at the end of energy
6077 C term evaluation for this virtual-bond angle.
6078 if (term1.gt.term2) then
6080 term2=dexp(term2-termm)
6084 term1=dexp(term1-termm)
6087 C The ratio between the gamma-independent and gamma-dependent lobes of
6088 C the distribution is a Gaussian function of thet_pred_mean too.
6089 diffak=gthet(2,it)-thet_pred_mean
6090 ratak=diffak/gthet(3,it)**2
6091 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6092 C Let's differentiate it in thet_pred_mean NOW.
6094 C Now put together the distribution terms to make complete distribution.
6095 termexp=term1+ak*term2
6096 termpre=sigc+ak*sig0i
6097 C Contribution of the bending energy from this theta is just the -log of
6098 C the sum of the contributions from the two lobes and the pre-exponential
6099 C factor. Simple enough, isn't it?
6100 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6101 C NOW the derivatives!!!
6102 C 6/6/97 Take into account the deformation.
6103 E_theta=(delthec*sigcsq*term1
6104 & +ak*delthe0*sig0inv*term2)/termexp
6105 E_tc=((sigtc+aktc*sig0i)/termpre
6106 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6107 & aktc*term2)/termexp)
6110 c-----------------------------------------------------------------------------
6111 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6112 implicit real*8 (a-h,o-z)
6113 include 'DIMENSIONS'
6114 include 'COMMON.LOCAL'
6115 include 'COMMON.IOUNITS'
6116 common /calcthet/ term1,term2,termm,diffak,ratak,
6117 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6118 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6119 delthec=thetai-thet_pred_mean
6120 delthe0=thetai-theta0i
6121 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6122 t3 = thetai-thet_pred_mean
6126 t14 = t12+t6*sigsqtc
6128 t21 = thetai-theta0i
6134 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6135 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6136 & *(-t12*t9-ak*sig0inv*t27)
6140 C--------------------------------------------------------------------------
6141 subroutine ebend(etheta)
6143 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6144 C angles gamma and its derivatives in consecutive thetas and gammas.
6145 C ab initio-derived potentials from
6146 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6148 implicit real*8 (a-h,o-z)
6149 include 'DIMENSIONS'
6150 include 'DIMENSIONS.ZSCOPT'
6151 include 'COMMON.LOCAL'
6152 include 'COMMON.GEO'
6153 include 'COMMON.INTERACT'
6154 include 'COMMON.DERIV'
6155 include 'COMMON.VAR'
6156 include 'COMMON.CHAIN'
6157 include 'COMMON.IOUNITS'
6158 include 'COMMON.NAMES'
6159 include 'COMMON.FFIELD'
6160 include 'COMMON.CONTROL'
6161 include 'COMMON.TORCNSTR'
6162 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6163 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6164 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6165 & sinph1ph2(maxdouble,maxdouble)
6166 logical lprn /.false./, lprn1 /.false./
6168 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
6169 do i=ithet_start,ithet_end
6171 C if (itype(i-1).eq.ntyp1) cycle
6173 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6174 & .or.itype(i).eq.ntyp1) cycle
6175 if (iabs(itype(i+1)).eq.20) iblock=2
6176 if (iabs(itype(i+1)).ne.20) iblock=1
6180 theti2=0.5d0*theta(i)
6181 ityp2=ithetyp((itype(i-1)))
6183 coskt(k)=dcos(k*theti2)
6184 sinkt(k)=dsin(k*theti2)
6194 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6197 if (phii.ne.phii) phii=150.0
6201 ityp1=ithetyp((itype(i-2)))
6203 cosph1(k)=dcos(k*phii)
6204 sinph1(k)=dsin(k*phii)
6210 ityp1=ithetyp((itype(i-2)))
6216 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6219 if (phii1.ne.phii1) phii1=150.0
6224 ityp3=ithetyp((itype(i)))
6226 cosph2(k)=dcos(k*phii1)
6227 sinph2(k)=dsin(k*phii1)
6232 ityp3=ithetyp((itype(i)))
6238 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
6239 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
6241 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6244 ccl=cosph1(l)*cosph2(k-l)
6245 ssl=sinph1(l)*sinph2(k-l)
6246 scl=sinph1(l)*cosph2(k-l)
6247 csl=cosph1(l)*sinph2(k-l)
6248 cosph1ph2(l,k)=ccl-ssl
6249 cosph1ph2(k,l)=ccl+ssl
6250 sinph1ph2(l,k)=scl+csl
6251 sinph1ph2(k,l)=scl-csl
6255 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6256 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6257 write (iout,*) "coskt and sinkt"
6259 write (iout,*) k,coskt(k),sinkt(k)
6263 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6264 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6267 & write (iout,*) "k",k,"
6268 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6269 & " ethetai",ethetai
6272 write (iout,*) "cosph and sinph"
6274 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6276 write (iout,*) "cosph1ph2 and sinph2ph2"
6279 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6280 & sinph1ph2(l,k),sinph1ph2(k,l)
6283 write(iout,*) "ethetai",ethetai
6287 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6288 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6289 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6290 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6291 ethetai=ethetai+sinkt(m)*aux
6292 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6293 dephii=dephii+k*sinkt(m)*(
6294 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6295 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6296 dephii1=dephii1+k*sinkt(m)*(
6297 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6298 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6300 & write (iout,*) "m",m," k",k," bbthet",
6301 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6302 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6303 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6304 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6308 & write(iout,*) "ethetai",ethetai
6312 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6313 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6314 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6315 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6316 ethetai=ethetai+sinkt(m)*aux
6317 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6318 dephii=dephii+l*sinkt(m)*(
6319 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6320 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6321 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6322 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6323 dephii1=dephii1+(k-l)*sinkt(m)*(
6324 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6325 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6326 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6327 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6329 write (iout,*) "m",m," k",k," l",l," ffthet",
6330 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6331 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6332 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6333 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6334 & " ethetai",ethetai
6335 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6336 & cosph1ph2(k,l)*sinkt(m),
6337 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6343 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6344 & i,theta(i)*rad2deg,phii*rad2deg,
6345 & phii1*rad2deg,ethetai
6346 etheta=etheta+ethetai
6347 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6348 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6349 c gloc(nphi+i-2,icg)=wang*dethetai
6350 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6356 c-----------------------------------------------------------------------------
6357 subroutine esc(escloc)
6358 C Calculate the local energy of a side chain and its derivatives in the
6359 C corresponding virtual-bond valence angles THETA and the spherical angles
6361 implicit real*8 (a-h,o-z)
6362 include 'DIMENSIONS'
6363 include 'DIMENSIONS.ZSCOPT'
6364 include 'COMMON.GEO'
6365 include 'COMMON.LOCAL'
6366 include 'COMMON.VAR'
6367 include 'COMMON.INTERACT'
6368 include 'COMMON.DERIV'
6369 include 'COMMON.CHAIN'
6370 include 'COMMON.IOUNITS'
6371 include 'COMMON.NAMES'
6372 include 'COMMON.FFIELD'
6373 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6374 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6375 common /sccalc/ time11,time12,time112,theti,it,nlobit
6378 C write (iout,*) 'ESC'
6379 do i=loc_start,loc_end
6381 if (it.eq.ntyp1) cycle
6382 if (it.eq.10) goto 1
6383 nlobit=nlob(iabs(it))
6384 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6385 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6386 theti=theta(i+1)-pipol
6390 c write (iout,*) "i",i," x",x(1),x(2),x(3)
6392 if (x(2).gt.pi-delta) then
6396 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6398 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6399 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6401 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6402 & ddersc0(1),dersc(1))
6403 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6404 & ddersc0(3),dersc(3))
6406 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6408 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6409 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6410 & dersc0(2),esclocbi,dersc02)
6411 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6413 call splinthet(x(2),0.5d0*delta,ss,ssd)
6418 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6420 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6421 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6423 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6425 c write (iout,*) escloci
6426 else if (x(2).lt.delta) then
6430 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6432 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6433 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6435 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6436 & ddersc0(1),dersc(1))
6437 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6438 & ddersc0(3),dersc(3))
6440 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6442 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6443 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6444 & dersc0(2),esclocbi,dersc02)
6445 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6450 call splinthet(x(2),0.5d0*delta,ss,ssd)
6452 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6454 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6455 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6457 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6458 C write (iout,*) 'i=',i, escloci
6460 call enesc(x,escloci,dersc,ddummy,.false.)
6463 escloc=escloc+escloci
6464 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6465 write (iout,'(a6,i5,0pf7.3)')
6466 & 'escloc',i,escloci
6468 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6470 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6471 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6476 C---------------------------------------------------------------------------
6477 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6478 implicit real*8 (a-h,o-z)
6479 include 'DIMENSIONS'
6480 include 'COMMON.GEO'
6481 include 'COMMON.LOCAL'
6482 include 'COMMON.IOUNITS'
6483 common /sccalc/ time11,time12,time112,theti,it,nlobit
6484 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6485 double precision contr(maxlob,-1:1)
6487 c write (iout,*) 'it=',it,' nlobit=',nlobit
6491 if (mixed) ddersc(j)=0.0d0
6495 C Because of periodicity of the dependence of the SC energy in omega we have
6496 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6497 C To avoid underflows, first compute & store the exponents.
6505 z(k)=x(k)-censc(k,j,it)
6510 Axk=Axk+gaussc(l,k,j,it)*z(l)
6516 expfac=expfac+Ax(k,j,iii)*z(k)
6524 C As in the case of ebend, we want to avoid underflows in exponentiation and
6525 C subsequent NaNs and INFs in energy calculation.
6526 C Find the largest exponent
6530 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6534 cd print *,'it=',it,' emin=',emin
6536 C Compute the contribution to SC energy and derivatives
6540 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6541 cd print *,'j=',j,' expfac=',expfac
6542 escloc_i=escloc_i+expfac
6544 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6548 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6549 & +gaussc(k,2,j,it))*expfac
6556 dersc(1)=dersc(1)/cos(theti)**2
6557 ddersc(1)=ddersc(1)/cos(theti)**2
6560 escloci=-(dlog(escloc_i)-emin)
6562 dersc(j)=dersc(j)/escloc_i
6566 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6571 C------------------------------------------------------------------------------
6572 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6573 implicit real*8 (a-h,o-z)
6574 include 'DIMENSIONS'
6575 include 'COMMON.GEO'
6576 include 'COMMON.LOCAL'
6577 include 'COMMON.IOUNITS'
6578 common /sccalc/ time11,time12,time112,theti,it,nlobit
6579 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6580 double precision contr(maxlob)
6591 z(k)=x(k)-censc(k,j,it)
6597 Axk=Axk+gaussc(l,k,j,it)*z(l)
6603 expfac=expfac+Ax(k,j)*z(k)
6608 C As in the case of ebend, we want to avoid underflows in exponentiation and
6609 C subsequent NaNs and INFs in energy calculation.
6610 C Find the largest exponent
6613 if (emin.gt.contr(j)) emin=contr(j)
6617 C Compute the contribution to SC energy and derivatives
6621 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6622 escloc_i=escloc_i+expfac
6624 dersc(k)=dersc(k)+Ax(k,j)*expfac
6626 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6627 & +gaussc(1,2,j,it))*expfac
6631 dersc(1)=dersc(1)/cos(theti)**2
6632 dersc12=dersc12/cos(theti)**2
6633 escloci=-(dlog(escloc_i)-emin)
6635 dersc(j)=dersc(j)/escloc_i
6637 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6641 c----------------------------------------------------------------------------------
6642 subroutine esc(escloc)
6643 C Calculate the local energy of a side chain and its derivatives in the
6644 C corresponding virtual-bond valence angles THETA and the spherical angles
6645 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6646 C added by Urszula Kozlowska. 07/11/2007
6648 implicit real*8 (a-h,o-z)
6649 include 'DIMENSIONS'
6650 include 'DIMENSIONS.ZSCOPT'
6651 include 'COMMON.GEO'
6652 include 'COMMON.LOCAL'
6653 include 'COMMON.VAR'
6654 include 'COMMON.SCROT'
6655 include 'COMMON.INTERACT'
6656 include 'COMMON.DERIV'
6657 include 'COMMON.CHAIN'
6658 include 'COMMON.IOUNITS'
6659 include 'COMMON.NAMES'
6660 include 'COMMON.FFIELD'
6661 include 'COMMON.CONTROL'
6662 include 'COMMON.VECTORS'
6663 double precision x_prime(3),y_prime(3),z_prime(3)
6664 & , sumene,dsc_i,dp2_i,x(65),
6665 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6666 & de_dxx,de_dyy,de_dzz,de_dt
6667 double precision s1_t,s1_6_t,s2_t,s2_6_t
6669 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6670 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6671 & dt_dCi(3),dt_dCi1(3)
6672 common /sccalc/ time11,time12,time112,theti,it,nlobit
6675 do i=loc_start,loc_end
6676 if (itype(i).eq.ntyp1) cycle
6677 costtab(i+1) =dcos(theta(i+1))
6678 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6679 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6680 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6681 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6682 cosfac=dsqrt(cosfac2)
6683 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6684 sinfac=dsqrt(sinfac2)
6686 if (it.eq.10) goto 1
6688 C Compute the axes of tghe local cartesian coordinates system; store in
6689 c x_prime, y_prime and z_prime
6696 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6697 C & dc_norm(3,i+nres)
6699 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6700 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6703 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6706 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6707 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6708 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6709 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6710 c & " xy",scalar(x_prime(1),y_prime(1)),
6711 c & " xz",scalar(x_prime(1),z_prime(1)),
6712 c & " yy",scalar(y_prime(1),y_prime(1)),
6713 c & " yz",scalar(y_prime(1),z_prime(1)),
6714 c & " zz",scalar(z_prime(1),z_prime(1))
6716 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6717 C to local coordinate system. Store in xx, yy, zz.
6723 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6724 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6725 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6732 C Compute the energy of the ith side cbain
6734 c write (2,*) "xx",xx," yy",yy," zz",zz
6737 x(j) = sc_parmin(j,it)
6740 Cc diagnostics - remove later
6742 yy1 = dsin(alph(2))*dcos(omeg(2))
6743 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
6744 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6745 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6747 C," --- ", xx_w,yy_w,zz_w
6750 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6751 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6753 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6754 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6756 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6757 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6758 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6759 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6760 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6762 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6763 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6764 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6765 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6766 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6768 dsc_i = 0.743d0+x(61)
6770 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6771 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6772 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6773 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6774 s1=(1+x(63))/(0.1d0 + dscp1)
6775 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6776 s2=(1+x(65))/(0.1d0 + dscp2)
6777 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6778 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6779 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6780 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6782 c & dscp1,dscp2,sumene
6783 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6784 escloc = escloc + sumene
6785 c write (2,*) "escloc",escloc
6786 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
6788 if (.not. calc_grad) goto 1
6791 C This section to check the numerical derivatives of the energy of ith side
6792 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6793 C #define DEBUG in the code to turn it on.
6795 write (2,*) "sumene =",sumene
6799 write (2,*) xx,yy,zz
6800 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6801 de_dxx_num=(sumenep-sumene)/aincr
6803 write (2,*) "xx+ sumene from enesc=",sumenep
6806 write (2,*) xx,yy,zz
6807 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6808 de_dyy_num=(sumenep-sumene)/aincr
6810 write (2,*) "yy+ sumene from enesc=",sumenep
6813 write (2,*) xx,yy,zz
6814 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6815 de_dzz_num=(sumenep-sumene)/aincr
6817 write (2,*) "zz+ sumene from enesc=",sumenep
6818 costsave=cost2tab(i+1)
6819 sintsave=sint2tab(i+1)
6820 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6821 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6822 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6823 de_dt_num=(sumenep-sumene)/aincr
6824 write (2,*) " t+ sumene from enesc=",sumenep
6825 cost2tab(i+1)=costsave
6826 sint2tab(i+1)=sintsave
6827 C End of diagnostics section.
6830 C Compute the gradient of esc
6832 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6833 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6834 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6835 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6836 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6837 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6838 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6839 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6840 pom1=(sumene3*sint2tab(i+1)+sumene1)
6841 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6842 pom2=(sumene4*cost2tab(i+1)+sumene2)
6843 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6844 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6845 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6846 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6848 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6849 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6850 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6852 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6853 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6854 & +(pom1+pom2)*pom_dx
6856 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
6859 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6860 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6861 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6863 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6864 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6865 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6866 & +x(59)*zz**2 +x(60)*xx*zz
6867 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6868 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6869 & +(pom1-pom2)*pom_dy
6871 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
6874 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6875 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6876 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6877 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6878 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6879 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6880 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6881 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6883 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
6886 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6887 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6888 & +pom1*pom_dt1+pom2*pom_dt2
6890 write(2,*), "de_dt = ", de_dt,de_dt_num
6894 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6895 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6896 cosfac2xx=cosfac2*xx
6897 sinfac2yy=sinfac2*yy
6899 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6901 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6903 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6904 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6905 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6906 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6907 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6908 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6909 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6910 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6911 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6912 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6916 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6917 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6918 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6919 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6922 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6923 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6924 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
6926 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6927 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6931 dXX_Ctab(k,i)=dXX_Ci(k)
6932 dXX_C1tab(k,i)=dXX_Ci1(k)
6933 dYY_Ctab(k,i)=dYY_Ci(k)
6934 dYY_C1tab(k,i)=dYY_Ci1(k)
6935 dZZ_Ctab(k,i)=dZZ_Ci(k)
6936 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6937 dXX_XYZtab(k,i)=dXX_XYZ(k)
6938 dYY_XYZtab(k,i)=dYY_XYZ(k)
6939 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6943 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6944 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6945 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6946 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6947 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6949 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6950 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6951 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6952 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6953 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6954 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6955 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6956 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6958 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6959 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6961 C to check gradient call subroutine check_grad
6968 c------------------------------------------------------------------------------
6969 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6971 C This procedure calculates two-body contact function g(rij) and its derivative:
6974 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6977 C where x=(rij-r0ij)/delta
6979 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6982 double precision rij,r0ij,eps0ij,fcont,fprimcont
6983 double precision x,x2,x4,delta
6987 if (x.lt.-1.0D0) then
6990 else if (x.le.1.0D0) then
6993 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6994 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7001 c------------------------------------------------------------------------------
7002 subroutine splinthet(theti,delta,ss,ssder)
7003 implicit real*8 (a-h,o-z)
7004 include 'DIMENSIONS'
7005 include 'DIMENSIONS.ZSCOPT'
7006 include 'COMMON.VAR'
7007 include 'COMMON.GEO'
7010 if (theti.gt.pipol) then
7011 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7013 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7018 c------------------------------------------------------------------------------
7019 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7021 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7022 double precision ksi,ksi2,ksi3,a1,a2,a3
7023 a1=fprim0*delta/(f1-f0)
7029 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7030 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7033 c------------------------------------------------------------------------------
7034 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7036 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7037 double precision ksi,ksi2,ksi3,a1,a2,a3
7042 a2=3*(f1x-f0x)-2*fprim0x*delta
7043 a3=fprim0x*delta-2*(f1x-f0x)
7044 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7047 C-----------------------------------------------------------------------------
7049 C-----------------------------------------------------------------------------
7050 subroutine etor(etors)
7051 implicit real*8 (a-h,o-z)
7052 include 'DIMENSIONS'
7053 include 'DIMENSIONS.ZSCOPT'
7054 include 'COMMON.VAR'
7055 include 'COMMON.GEO'
7056 include 'COMMON.LOCAL'
7057 include 'COMMON.TORSION'
7058 include 'COMMON.INTERACT'
7059 include 'COMMON.DERIV'
7060 include 'COMMON.CHAIN'
7061 include 'COMMON.NAMES'
7062 include 'COMMON.IOUNITS'
7063 include 'COMMON.FFIELD'
7064 include 'COMMON.TORCNSTR'
7066 C Set lprn=.true. for debugging
7070 do i=iphi_start,iphi_end
7071 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
7072 & .or. itype(i).eq.ntyp1) cycle
7073 itori=itortyp(itype(i-2))
7074 itori1=itortyp(itype(i-1))
7077 C Proline-Proline pair is a special case...
7078 if (itori.eq.3 .and. itori1.eq.3) then
7079 if (phii.gt.-dwapi3) then
7081 fac=1.0D0/(1.0D0-cosphi)
7082 etorsi=v1(1,3,3)*fac
7083 etorsi=etorsi+etorsi
7084 etors=etors+etorsi-v1(1,3,3)
7085 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7088 v1ij=v1(j+1,itori,itori1)
7089 v2ij=v2(j+1,itori,itori1)
7092 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7093 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7097 v1ij=v1(j,itori,itori1)
7098 v2ij=v2(j,itori,itori1)
7101 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7102 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7106 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7107 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7108 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7109 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7110 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7114 c------------------------------------------------------------------------------
7116 subroutine etor(etors)
7117 implicit real*8 (a-h,o-z)
7118 include 'DIMENSIONS'
7119 include 'DIMENSIONS.ZSCOPT'
7120 include 'COMMON.VAR'
7121 include 'COMMON.GEO'
7122 include 'COMMON.LOCAL'
7123 include 'COMMON.TORSION'
7124 include 'COMMON.INTERACT'
7125 include 'COMMON.DERIV'
7126 include 'COMMON.CHAIN'
7127 include 'COMMON.NAMES'
7128 include 'COMMON.IOUNITS'
7129 include 'COMMON.FFIELD'
7130 include 'COMMON.TORCNSTR'
7131 include 'COMMON.WEIGHTS'
7132 include 'COMMON.WEIGHTDER'
7134 C Set lprn=.true. for debugging
7143 etor_temp(l,k,j,i,iblock)=0.0d0
7149 do i=iphi_start,iphi_end
7151 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7152 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7153 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
7154 if (iabs(itype(i)).eq.20) then
7159 itori=itortyp(itype(i-2))
7160 itori1=itortyp(itype(i-1))
7161 weitori=weitor(0,itori,itori1,iblock)
7165 C Regular cosine and sine terms
7166 do j=1,nterm(itori,itori1,iblock)
7167 v1ij=v1(j,itori,itori1,iblock)
7168 v2ij=v2(j,itori,itori1,iblock)
7171 etori=etori+v1ij*cosphi+v2ij*sinphi
7172 etor_temp(j,0,itori,itori1,iblock)=
7173 & etor_temp(j,0,itori,itori1,iblock)+cosphi*ww(13)
7174 etor_temp(nterm(itori,itori1,iblock)+j,0,itori,itori1,iblock)=
7175 & etor_temp(nterm(itori,itori1,iblock)+j,0,itori,itori1,iblock)+
7177 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7181 C E = SUM ----------------------------------- - v1
7182 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7184 cosphi=dcos(0.5d0*phii)
7185 sinphi=dsin(0.5d0*phii)
7186 do j=1,nlor(itori,itori1,iblock)
7187 vl1ij=vlor1(j,itori,itori1)
7188 vl2ij=vlor2(j,itori,itori1)
7189 vl3ij=vlor3(j,itori,itori1)
7190 pom=vl2ij*cosphi+vl3ij*sinphi
7191 pom1=1.0d0/(pom*pom+1.0d0)
7192 etori=etori+vl1ij*pom1
7194 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7196 C Subtract the constant term
7197 etors=etors+(etori-v0(itori,itori1,iblock))*weitori
7198 etor_temp(0,0,itori,itori1,1)=etor_temp(0,0,itori,itori1,1)+
7199 & (etori-v0(itori,itori1,iblock))*ww(13)
7202 write (iout,'(2(a3,2x,i3,2x),2i3,8f8.3/26x,6f8.3/)')
7203 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7204 & weitori,v0(itori,itori1,iblock)*weitori,
7205 & (v1(j,itori,itori1,iblock)*weitori,
7206 & j=1,6),(v2(j,itori,itori1,iblock)*weitori,j=1,6)
7207 write (iout,*) "typ",itori,iloctyp(itori),itori1,
7208 & iloctyp(itori1)," etor_temp",
7209 & etor_temp(0,0,itori,itori1,1)
7212 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7213 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7218 c----------------------------------------------------------------------------
7219 subroutine etor_d(etors_d)
7220 C 6/23/01 Compute double torsional energy
7221 implicit real*8 (a-h,o-z)
7222 include 'DIMENSIONS'
7223 include 'DIMENSIONS.ZSCOPT'
7224 include 'COMMON.VAR'
7225 include 'COMMON.GEO'
7226 include 'COMMON.LOCAL'
7227 include 'COMMON.TORSION'
7228 include 'COMMON.INTERACT'
7229 include 'COMMON.DERIV'
7230 include 'COMMON.CHAIN'
7231 include 'COMMON.NAMES'
7232 include 'COMMON.IOUNITS'
7233 include 'COMMON.FFIELD'
7234 include 'COMMON.TORCNSTR'
7236 C Set lprn=.true. for debugging
7240 do i=iphi_start,iphi_end-1
7242 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7243 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
7244 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7245 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7246 & (itype(i+1).eq.ntyp1)) cycle
7247 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
7249 itori=itortyp(itype(i-2))
7250 itori1=itortyp(itype(i-1))
7251 itori2=itortyp(itype(i))
7257 if (iabs(itype(i+1)).eq.20) iblock=2
7258 C Regular cosine and sine terms
7259 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7260 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7261 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7262 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7263 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7264 cosphi1=dcos(j*phii)
7265 sinphi1=dsin(j*phii)
7266 cosphi2=dcos(j*phii1)
7267 sinphi2=dsin(j*phii1)
7268 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7269 & v2cij*cosphi2+v2sij*sinphi2
7270 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7271 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7273 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7275 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7276 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7277 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7278 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7279 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7280 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7281 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7282 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7283 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7284 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7285 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7286 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7287 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7288 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7291 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7292 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7298 c---------------------------------------------------------------------------
7299 C The rigorous attempt to derive energy function
7300 subroutine etor_kcc(etors)
7301 implicit real*8 (a-h,o-z)
7302 include 'DIMENSIONS'
7303 include 'DIMENSIONS.ZSCOPT'
7304 include 'COMMON.VAR'
7305 include 'COMMON.GEO'
7306 include 'COMMON.LOCAL'
7307 include 'COMMON.TORSION'
7308 include 'COMMON.INTERACT'
7309 include 'COMMON.DERIV'
7310 include 'COMMON.CHAIN'
7311 include 'COMMON.NAMES'
7312 include 'COMMON.IOUNITS'
7313 include 'COMMON.FFIELD'
7314 include 'COMMON.TORCNSTR'
7315 include 'COMMON.CONTROL'
7316 include 'COMMON.WEIGHTS'
7317 include 'COMMON.WEIGHTDER'
7318 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
7320 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7321 C Set lprn=.true. for debugging
7324 if (lprn) write (iout,*)"ETOR_KCC"
7330 etor_temp(l,k,j,i,iblock)=0.0d0
7341 etor_temp_kcc(ll,l,k,j,i)=0.0d0
7347 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7349 do i=iphi_start,iphi_end
7350 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7351 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7352 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7353 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7354 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7355 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7356 itori=itortyp(itype(i-2))
7357 itori1=itortyp(itype(i-1))
7358 weitori=weitor(0,itori,itori1,1)
7359 if (lprn) write (iout,*) i-2,i-2,itori,itori1,"weitor",weitori
7364 C to avoid multiple devision by 2
7365 c theti22=0.5d0*theta(i)
7366 C theta 12 is the theta_1 /2
7367 C theta 22 is theta_2 /2
7368 c theti12=0.5d0*theta(i-1)
7369 C and appropriate sinus function
7370 sinthet1=dsin(theta(i-1))
7371 sinthet2=dsin(theta(i))
7372 costhet1=dcos(theta(i-1))
7373 costhet2=dcos(theta(i))
7374 C to speed up lets store its mutliplication
7375 sint1t2=sinthet2*sinthet1
7377 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7378 C +d_n*sin(n*gamma)) *
7379 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7380 C we have two sum 1) Non-Chebyshev which is with n and gamma
7381 nval=nterm_kcc_Tb(itori,itori1)
7387 c1(j)=c1(j-1)*costhet1
7388 c2(j)=c2(j-1)*costhet2
7391 do j=1,nterm_kcc(itori,itori1)
7395 sint1t2n=sint1t2n*sint1t2
7401 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7402 etor_temp_kcc(l,k,j,itori,itori1)=
7403 & etor_temp_kcc(l,k,j,itori,itori1)+
7404 & c1(k)*c2(l)*sint1t2n*cosphi*ww(13)
7405 gradvalct1=gradvalct1+
7406 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7407 gradvalct2=gradvalct2+
7408 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7411 gradvalct1=-gradvalct1*sinthet1
7412 gradvalct2=-gradvalct2*sinthet2
7418 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7419 etor_temp_kcc(l,k,j+nterm_kcc(itori,itori1),itori,itori1)=
7420 & etor_temp_kcc(l,k,j+nterm_kcc(itori,itori1),itori,itori1)+
7421 & c1(k)*c2(l)*sint1t2n*sinphi*ww(13)
7422 gradvalst1=gradvalst1+
7423 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7424 gradvalst2=gradvalst2+
7425 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7428 gradvalst1=-gradvalst1*sinthet1
7429 gradvalst2=-gradvalst2*sinthet2
7430 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
7431 etor_temp(0,0,itori,itori1,1)=etor_temp(0,0,itori,itori1,1)
7432 & +sint1t2n*(sumvalc*cosphi+sumvals*sinphi)*ww(13)
7433 C glocig is the gradient local i site in gamma
7434 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
7435 C now gradient over theta_1
7436 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
7437 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
7438 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
7439 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
7441 etors=etors+etori*weitori
7442 C derivative over gamma
7443 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7444 C derivative over theta1
7445 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7446 C now derivative over theta2
7447 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7449 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
7450 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7454 c---------------------------------------------------------------------------------------------
7455 subroutine etor_constr(edihcnstr)
7456 implicit real*8 (a-h,o-z)
7457 include 'DIMENSIONS'
7458 include 'DIMENSIONS.ZSCOPT'
7459 include 'COMMON.VAR'
7460 include 'COMMON.GEO'
7461 include 'COMMON.LOCAL'
7462 include 'COMMON.TORSION'
7463 include 'COMMON.INTERACT'
7464 include 'COMMON.DERIV'
7465 include 'COMMON.CHAIN'
7466 include 'COMMON.NAMES'
7467 include 'COMMON.IOUNITS'
7468 include 'COMMON.FFIELD'
7469 include 'COMMON.TORCNSTR'
7470 include 'COMMON.CONTROL'
7471 ! 6/20/98 - dihedral angle constraints
7473 c do i=1,ndih_constr
7474 c write (iout,*) "idihconstr_start",idihconstr_start,
7475 c & " idihconstr_end",idihconstr_end
7476 do i=idihconstr_start,idihconstr_end
7477 itori=idih_constr(i)
7479 difi=pinorm(phii-phi0(i))
7480 if (difi.gt.drange(i)) then
7482 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7483 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7484 else if (difi.lt.-drange(i)) then
7486 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7487 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7494 c----------------------------------------------------------------------------
7495 C The rigorous attempt to derive energy function
7496 subroutine ebend_kcc(etheta)
7498 implicit real*8 (a-h,o-z)
7499 include 'DIMENSIONS'
7500 include 'DIMENSIONS.ZSCOPT'
7501 include 'COMMON.VAR'
7502 include 'COMMON.GEO'
7503 include 'COMMON.LOCAL'
7504 include 'COMMON.TORSION'
7505 include 'COMMON.INTERACT'
7506 include 'COMMON.DERIV'
7507 include 'COMMON.CHAIN'
7508 include 'COMMON.NAMES'
7509 include 'COMMON.IOUNITS'
7510 include 'COMMON.FFIELD'
7511 include 'COMMON.TORCNSTR'
7512 include 'COMMON.CONTROL'
7513 include 'COMMON.WEIGHTDER'
7515 double precision thybt1(maxang_kcc)
7516 C Set lprn=.true. for debugging
7519 C print *,"wchodze kcc"
7520 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7523 ebend_temp_kcc(j,i)=0.0d0
7527 do i=ithet_start,ithet_end
7528 c print *,i,itype(i-1),itype(i),itype(i-2)
7529 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
7530 & .or.itype(i).eq.ntyp1) cycle
7531 iti=iabs(itortyp(itype(i-1)))
7532 sinthet=dsin(theta(i))
7533 costhet=dcos(theta(i))
7534 do j=1,nbend_kcc_Tb(iti)
7535 thybt1(j)=v1bend_chyb(j,iti)
7536 ebend_temp_kcc(j,iabs(iti))=
7537 & ebend_temp_kcc(j,iabs(iti))+dcos(j*theta(i))
7539 sumth1thyb=v1bend_chyb(0,iti)+
7540 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7541 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
7543 ihelp=nbend_kcc_Tb(iti)-1
7544 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
7545 etheta=etheta+sumth1thyb
7546 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7547 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
7551 c-------------------------------------------------------------------------------------
7552 subroutine etheta_constr(ethetacnstr)
7554 implicit real*8 (a-h,o-z)
7555 include 'DIMENSIONS'
7556 include 'DIMENSIONS.ZSCOPT'
7557 include 'COMMON.VAR'
7558 include 'COMMON.GEO'
7559 include 'COMMON.LOCAL'
7560 include 'COMMON.TORSION'
7561 include 'COMMON.INTERACT'
7562 include 'COMMON.DERIV'
7563 include 'COMMON.CHAIN'
7564 include 'COMMON.NAMES'
7565 include 'COMMON.IOUNITS'
7566 include 'COMMON.FFIELD'
7567 include 'COMMON.TORCNSTR'
7568 include 'COMMON.CONTROL'
7570 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7571 do i=ithetaconstr_start,ithetaconstr_end
7572 itheta=itheta_constr(i)
7573 thetiii=theta(itheta)
7574 difi=pinorm(thetiii-theta_constr0(i))
7575 if (difi.gt.theta_drange(i)) then
7576 difi=difi-theta_drange(i)
7577 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7578 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7579 & +for_thet_constr(i)*difi**3
7580 else if (difi.lt.-drange(i)) then
7582 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7583 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7584 & +for_thet_constr(i)*difi**3
7588 if (energy_dec) then
7589 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
7590 & i,itheta,rad2deg*thetiii,
7591 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
7592 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
7593 & gloc(itheta+nphi-2,icg)
7598 c------------------------------------------------------------------------------
7599 subroutine eback_sc_corr(esccor)
7600 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7601 c conformational states; temporarily implemented as differences
7602 c between UNRES torsional potentials (dependent on three types of
7603 c residues) and the torsional potentials dependent on all 20 types
7604 c of residues computed from AM1 energy surfaces of terminally-blocked
7605 c amino-acid residues.
7606 implicit real*8 (a-h,o-z)
7607 include 'DIMENSIONS'
7608 include 'DIMENSIONS.ZSCOPT'
7609 include 'COMMON.VAR'
7610 include 'COMMON.GEO'
7611 include 'COMMON.LOCAL'
7612 include 'COMMON.TORSION'
7613 include 'COMMON.SCCOR'
7614 include 'COMMON.INTERACT'
7615 include 'COMMON.DERIV'
7616 include 'COMMON.CHAIN'
7617 include 'COMMON.NAMES'
7618 include 'COMMON.IOUNITS'
7619 include 'COMMON.FFIELD'
7620 include 'COMMON.CONTROL'
7622 C Set lprn=.true. for debugging
7625 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
7627 do i=itau_start,itau_end
7628 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7630 isccori=isccortyp(itype(i-2))
7631 isccori1=isccortyp(itype(i-1))
7633 do intertyp=1,3 !intertyp
7634 cc Added 09 May 2012 (Adasko)
7635 cc Intertyp means interaction type of backbone mainchain correlation:
7636 c 1 = SC...Ca...Ca...Ca
7637 c 2 = Ca...Ca...Ca...SC
7638 c 3 = SC...Ca...Ca...SCi
7640 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7641 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7642 & (itype(i-1).eq.ntyp1)))
7643 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7644 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7645 & .or.(itype(i).eq.ntyp1)))
7646 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7647 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7648 & (itype(i-3).eq.ntyp1)))) cycle
7649 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7650 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7652 do j=1,nterm_sccor(isccori,isccori1)
7653 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7654 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7655 cosphi=dcos(j*tauangle(intertyp,i))
7656 sinphi=dsin(j*tauangle(intertyp,i))
7657 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7658 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7660 C write (iout,*)"EBACK_SC_COR",esccor,i
7661 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
7662 c & nterm_sccor(isccori,isccori1),isccori,isccori1
7663 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7665 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7666 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7667 & (v1sccor(j,1,itori,itori1),j=1,6)
7668 & ,(v2sccor(j,1,itori,itori1),j=1,6)
7669 c gsccor_loc(i-3)=gloci
7674 c------------------------------------------------------------------------------
7675 subroutine multibody(ecorr)
7676 C This subroutine calculates multi-body contributions to energy following
7677 C the idea of Skolnick et al. If side chains I and J make a contact and
7678 C at the same time side chains I+1 and J+1 make a contact, an extra
7679 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7680 implicit real*8 (a-h,o-z)
7681 include 'DIMENSIONS'
7682 include 'DIMENSIONS.ZSCOPT'
7683 include 'COMMON.IOUNITS'
7684 include 'COMMON.DERIV'
7685 include 'COMMON.INTERACT'
7686 include 'COMMON.CONTACTS'
7687 double precision gx(3),gx1(3)
7690 C Set lprn=.true. for debugging
7694 write (iout,'(a)') 'Contact function values:'
7696 write (iout,'(i2,20(1x,i2,f10.5))')
7697 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7712 num_conti=num_cont(i)
7713 num_conti1=num_cont(i1)
7718 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7719 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7720 cd & ' ishift=',ishift
7721 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7722 C The system gains extra energy.
7723 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7724 endif ! j1==j+-ishift
7733 c------------------------------------------------------------------------------
7734 double precision function esccorr(i,j,k,l,jj,kk)
7735 implicit real*8 (a-h,o-z)
7736 include 'DIMENSIONS'
7737 include 'DIMENSIONS.ZSCOPT'
7738 include 'COMMON.IOUNITS'
7739 include 'COMMON.DERIV'
7740 include 'COMMON.INTERACT'
7741 include 'COMMON.CONTACTS'
7742 double precision gx(3),gx1(3)
7747 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7748 C Calculate the multi-body contribution to energy.
7749 C Calculate multi-body contributions to the gradient.
7750 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7751 cd & k,l,(gacont(m,kk,k),m=1,3)
7753 gx(m) =ekl*gacont(m,jj,i)
7754 gx1(m)=eij*gacont(m,kk,k)
7755 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7756 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7757 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7758 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7762 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7767 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7773 c------------------------------------------------------------------------------
7774 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7775 C This subroutine calculates multi-body contributions to hydrogen-bonding
7776 implicit real*8 (a-h,o-z)
7777 include 'DIMENSIONS'
7778 include 'DIMENSIONS.ZSCOPT'
7779 include 'COMMON.IOUNITS'
7780 include 'COMMON.FFIELD'
7781 include 'COMMON.DERIV'
7782 include 'COMMON.INTERACT'
7783 include 'COMMON.CONTACTS'
7784 double precision gx(3),gx1(3)
7787 C Set lprn=.true. for debugging
7790 write (iout,'(a)') 'Contact function values:'
7792 write (iout,'(2i3,50(1x,i2,f5.2))')
7793 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7794 & j=1,num_cont_hb(i))
7798 C Remove the loop below after debugging !!!
7805 C Calculate the local-electrostatic correlation terms
7806 do i=iatel_s,iatel_e+1
7808 num_conti=num_cont_hb(i)
7809 num_conti1=num_cont_hb(i+1)
7814 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7815 c & ' jj=',jj,' kk=',kk
7816 if (j1.eq.j+1 .or. j1.eq.j-1) then
7817 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7818 C The system gains extra energy.
7819 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7821 else if (j1.eq.j) then
7822 C Contacts I-J and I-(J+1) occur simultaneously.
7823 C The system loses extra energy.
7824 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7829 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7830 c & ' jj=',jj,' kk=',kk
7832 C Contacts I-J and (I+1)-J occur simultaneously.
7833 C The system loses extra energy.
7834 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7841 c------------------------------------------------------------------------------
7842 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7844 C This subroutine calculates multi-body contributions to hydrogen-bonding
7845 implicit real*8 (a-h,o-z)
7846 include 'DIMENSIONS'
7847 include 'DIMENSIONS.ZSCOPT'
7848 include 'COMMON.IOUNITS'
7852 include 'COMMON.FFIELD'
7853 include 'COMMON.DERIV'
7854 include 'COMMON.LOCAL'
7855 include 'COMMON.INTERACT'
7856 include 'COMMON.CONTACTS'
7857 include 'COMMON.CHAIN'
7858 include 'COMMON.CONTROL'
7859 include 'COMMON.SHIELD'
7860 double precision gx(3),gx1(3)
7861 integer num_cont_hb_old(maxres)
7863 double precision eello4,eello5,eelo6,eello_turn6
7864 external eello4,eello5,eello6,eello_turn6
7865 C Set lprn=.true. for debugging
7869 write (iout,'(a)') 'Contact function values:'
7871 write (iout,'(2i3,50(1x,i2,5f6.3))')
7872 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7873 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7879 C Remove the loop below after debugging !!!
7886 C Calculate the dipole-dipole interaction energies
7887 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7888 do i=iatel_s,iatel_e+1
7889 num_conti=num_cont_hb(i)
7898 C Calculate the local-electrostatic correlation terms
7899 c write (iout,*) "gradcorr5 in eello5 before loop"
7901 c write (iout,'(i5,3f10.5)')
7902 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7904 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7905 c write (iout,*) "corr loop i",i
7907 num_conti=num_cont_hb(i)
7908 num_conti1=num_cont_hb(i+1)
7915 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7916 c & ' jj=',jj,' kk=',kk
7917 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7918 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7919 & .or. j.lt.0 .and. j1.gt.0) .and.
7920 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7921 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7922 C The system gains extra energy.
7924 sqd1=dsqrt(d_cont(jj,i))
7925 sqd2=dsqrt(d_cont(kk,i1))
7926 sred_geom = sqd1*sqd2
7927 IF (sred_geom.lt.cutoff_corr) THEN
7928 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7930 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7931 cd & ' jj=',jj,' kk=',kk
7932 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7933 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7935 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7936 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7939 cd write (iout,*) 'sred_geom=',sred_geom,
7940 cd & ' ekont=',ekont,' fprim=',fprimcont,
7941 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7942 cd write (iout,*) "g_contij",g_contij
7943 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7944 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7945 call calc_eello(i,jp,i+1,jp1,jj,kk)
7946 if (wcorr4.gt.0.0d0)
7947 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7948 CC & *fac_shield(i)**2*fac_shield(j)**2
7949 if (energy_dec.and.wcorr4.gt.0.0d0)
7950 1 write (iout,'(a6,4i5,0pf7.3)')
7951 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7952 c write (iout,*) "gradcorr5 before eello5"
7954 c write (iout,'(i5,3f10.5)')
7955 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7957 if (wcorr5.gt.0.0d0)
7958 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7959 c write (iout,*) "gradcorr5 after eello5"
7961 c write (iout,'(i5,3f10.5)')
7962 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7964 if (energy_dec.and.wcorr5.gt.0.0d0)
7965 1 write (iout,'(a6,4i5,0pf7.3)')
7966 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7967 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7968 cd write(2,*)'ijkl',i,jp,i+1,jp1
7969 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7970 & .or. wturn6.eq.0.0d0))then
7971 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7972 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7973 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7974 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7975 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7976 cd & 'ecorr6=',ecorr6
7977 cd write (iout,'(4e15.5)') sred_geom,
7978 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7979 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7980 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7981 else if (wturn6.gt.0.0d0
7982 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7983 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7984 eturn6=eturn6+eello_turn6(i,jj,kk)
7985 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7986 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7987 cd write (2,*) 'multibody_eello:eturn6',eturn6
7996 num_cont_hb(i)=num_cont_hb_old(i)
7998 c write (iout,*) "gradcorr5 in eello5"
8000 c write (iout,'(i5,3f10.5)')
8001 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8005 c------------------------------------------------------------------------------
8006 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8007 implicit real*8 (a-h,o-z)
8008 include 'DIMENSIONS'
8009 include 'DIMENSIONS.ZSCOPT'
8010 include 'COMMON.IOUNITS'
8011 include 'COMMON.DERIV'
8012 include 'COMMON.INTERACT'
8013 include 'COMMON.CONTACTS'
8014 include 'COMMON.SHIELD'
8015 include 'COMMON.CONTROL'
8016 double precision gx(3),gx1(3)
8019 C print *,"wchodze",fac_shield(i),shield_mode
8027 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8029 C & fac_shield(i)**2*fac_shield(j)**2
8030 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8031 C Following 4 lines for diagnostics.
8036 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8037 c & 'Contacts ',i,j,
8038 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8039 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8041 C Calculate the multi-body contribution to energy.
8042 C ecorr=ecorr+ekont*ees
8043 C Calculate multi-body contributions to the gradient.
8044 coeffpees0pij=coeffp*ees0pij
8045 coeffmees0mij=coeffm*ees0mij
8046 coeffpees0pkl=coeffp*ees0pkl
8047 coeffmees0mkl=coeffm*ees0mkl
8049 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8050 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8051 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8052 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8053 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8054 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8055 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8056 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8057 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8058 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8059 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8060 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8061 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8062 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8063 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8064 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8065 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8066 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8067 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8068 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8069 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8070 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8071 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8072 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8073 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8078 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8079 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8080 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8081 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8086 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8087 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8088 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8089 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8092 c write (iout,*) "ehbcorr",ekont*ees
8093 C print *,ekont,ees,i,k
8095 C now gradient over shielding
8097 if (shield_mode.gt.0) then
8100 C print *,i,j,fac_shield(i),fac_shield(j),
8101 C &fac_shield(k),fac_shield(l)
8102 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
8103 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8104 do ilist=1,ishield_list(i)
8105 iresshield=shield_list(ilist,i)
8107 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8109 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8111 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8112 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8116 do ilist=1,ishield_list(j)
8117 iresshield=shield_list(ilist,j)
8119 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8121 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8123 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8124 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8129 do ilist=1,ishield_list(k)
8130 iresshield=shield_list(ilist,k)
8132 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8134 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8136 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8137 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8141 do ilist=1,ishield_list(l)
8142 iresshield=shield_list(ilist,l)
8144 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8146 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8148 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8149 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8153 C print *,gshieldx(m,iresshield)
8155 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
8156 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8157 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
8158 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8159 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
8160 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8161 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
8162 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8164 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
8165 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8166 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
8167 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8168 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
8169 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8170 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
8171 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8179 C---------------------------------------------------------------------------
8180 subroutine dipole(i,j,jj)
8181 implicit real*8 (a-h,o-z)
8182 include 'DIMENSIONS'
8183 include 'DIMENSIONS.ZSCOPT'
8184 include 'COMMON.IOUNITS'
8185 include 'COMMON.CHAIN'
8186 include 'COMMON.FFIELD'
8187 include 'COMMON.DERIV'
8188 include 'COMMON.INTERACT'
8189 include 'COMMON.CONTACTS'
8190 include 'COMMON.TORSION'
8191 include 'COMMON.VAR'
8192 include 'COMMON.GEO'
8193 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8195 iti1 = itortyp(itype(i+1))
8196 if (j.lt.nres-1) then
8197 itj1 = itype2loc(itype(j+1))
8202 dipi(iii,1)=Ub2(iii,i)
8203 dipderi(iii)=Ub2der(iii,i)
8204 dipi(iii,2)=b1(iii,i+1)
8205 dipj(iii,1)=Ub2(iii,j)
8206 dipderj(iii)=Ub2der(iii,j)
8207 dipj(iii,2)=b1(iii,j+1)
8211 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8214 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8221 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8225 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8230 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8231 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8233 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8235 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8237 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8242 C---------------------------------------------------------------------------
8243 subroutine calc_eello(i,j,k,l,jj,kk)
8245 C This subroutine computes matrices and vectors needed to calculate
8246 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8248 implicit real*8 (a-h,o-z)
8249 include 'DIMENSIONS'
8250 include 'DIMENSIONS.ZSCOPT'
8251 include 'COMMON.IOUNITS'
8252 include 'COMMON.CHAIN'
8253 include 'COMMON.DERIV'
8254 include 'COMMON.INTERACT'
8255 include 'COMMON.CONTACTS'
8256 include 'COMMON.TORSION'
8257 include 'COMMON.VAR'
8258 include 'COMMON.GEO'
8259 include 'COMMON.FFIELD'
8260 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8261 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8264 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8265 cd & ' jj=',jj,' kk=',kk
8266 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8267 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8268 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8271 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8272 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8275 call transpose2(aa1(1,1),aa1t(1,1))
8276 call transpose2(aa2(1,1),aa2t(1,1))
8279 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8280 & aa1tder(1,1,lll,kkk))
8281 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8282 & aa2tder(1,1,lll,kkk))
8286 C parallel orientation of the two CA-CA-CA frames.
8288 iti=itype2loc(itype(i))
8292 itk1=itype2loc(itype(k+1))
8293 itj=itype2loc(itype(j))
8294 if (l.lt.nres-1) then
8295 itl1=itype2loc(itype(l+1))
8299 C A1 kernel(j+1) A2T
8301 cd write (iout,'(3f10.5,5x,3f10.5)')
8302 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8304 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8305 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8306 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8307 C Following matrices are needed only for 6-th order cumulants
8308 IF (wcorr6.gt.0.0d0) THEN
8309 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8310 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8311 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8312 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8313 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8314 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8315 & ADtEAderx(1,1,1,1,1,1))
8317 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8318 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8319 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8320 & ADtEA1derx(1,1,1,1,1,1))
8322 C End 6-th order cumulants
8325 cd write (2,*) 'In calc_eello6'
8327 cd write (2,*) 'iii=',iii
8329 cd write (2,*) 'kkk=',kkk
8331 cd write (2,'(3(2f10.5),5x)')
8332 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8337 call transpose2(EUgder(1,1,k),auxmat(1,1))
8338 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8339 call transpose2(EUg(1,1,k),auxmat(1,1))
8340 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8341 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8345 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8346 & EAEAderx(1,1,lll,kkk,iii,1))
8350 C A1T kernel(i+1) A2
8351 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8352 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8353 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8354 C Following matrices are needed only for 6-th order cumulants
8355 IF (wcorr6.gt.0.0d0) THEN
8356 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8357 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8358 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8359 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8360 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8361 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8362 & ADtEAderx(1,1,1,1,1,2))
8363 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8364 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8365 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8366 & ADtEA1derx(1,1,1,1,1,2))
8368 C End 6-th order cumulants
8369 call transpose2(EUgder(1,1,l),auxmat(1,1))
8370 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8371 call transpose2(EUg(1,1,l),auxmat(1,1))
8372 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8373 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8377 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8378 & EAEAderx(1,1,lll,kkk,iii,2))
8383 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8384 C They are needed only when the fifth- or the sixth-order cumulants are
8386 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8387 call transpose2(AEA(1,1,1),auxmat(1,1))
8388 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8389 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8390 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8391 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8392 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8393 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8394 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8395 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8396 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8397 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8398 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8399 call transpose2(AEA(1,1,2),auxmat(1,1))
8400 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8401 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8402 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8403 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8404 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8405 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8406 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8407 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8408 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8409 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8410 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8411 C Calculate the Cartesian derivatives of the vectors.
8415 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8416 call matvec2(auxmat(1,1),b1(1,i),
8417 & AEAb1derx(1,lll,kkk,iii,1,1))
8418 call matvec2(auxmat(1,1),Ub2(1,i),
8419 & AEAb2derx(1,lll,kkk,iii,1,1))
8420 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8421 & AEAb1derx(1,lll,kkk,iii,2,1))
8422 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8423 & AEAb2derx(1,lll,kkk,iii,2,1))
8424 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8425 call matvec2(auxmat(1,1),b1(1,j),
8426 & AEAb1derx(1,lll,kkk,iii,1,2))
8427 call matvec2(auxmat(1,1),Ub2(1,j),
8428 & AEAb2derx(1,lll,kkk,iii,1,2))
8429 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8430 & AEAb1derx(1,lll,kkk,iii,2,2))
8431 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8432 & AEAb2derx(1,lll,kkk,iii,2,2))
8439 C Antiparallel orientation of the two CA-CA-CA frames.
8441 iti=itype2loc(itype(i))
8445 itk1=itype2loc(itype(k+1))
8446 itl=itype2loc(itype(l))
8447 itj=itype2loc(itype(j))
8448 if (j.lt.nres-1) then
8449 itj1=itype2loc(itype(j+1))
8453 C A2 kernel(j-1)T A1T
8454 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8455 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8456 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8457 C Following matrices are needed only for 6-th order cumulants
8458 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8459 & j.eq.i+4 .and. l.eq.i+3)) THEN
8460 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8461 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8462 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8463 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8464 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8465 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8466 & ADtEAderx(1,1,1,1,1,1))
8467 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8468 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8469 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8470 & ADtEA1derx(1,1,1,1,1,1))
8472 C End 6-th order cumulants
8473 call transpose2(EUgder(1,1,k),auxmat(1,1))
8474 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8475 call transpose2(EUg(1,1,k),auxmat(1,1))
8476 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8477 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8481 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8482 & EAEAderx(1,1,lll,kkk,iii,1))
8486 C A2T kernel(i+1)T A1
8487 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8488 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8489 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8490 C Following matrices are needed only for 6-th order cumulants
8491 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8492 & j.eq.i+4 .and. l.eq.i+3)) THEN
8493 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8494 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8495 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8496 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8497 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8498 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8499 & ADtEAderx(1,1,1,1,1,2))
8500 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8501 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8502 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8503 & ADtEA1derx(1,1,1,1,1,2))
8505 C End 6-th order cumulants
8506 call transpose2(EUgder(1,1,j),auxmat(1,1))
8507 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8508 call transpose2(EUg(1,1,j),auxmat(1,1))
8509 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8510 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8514 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8515 & EAEAderx(1,1,lll,kkk,iii,2))
8520 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8521 C They are needed only when the fifth- or the sixth-order cumulants are
8523 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8524 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8525 call transpose2(AEA(1,1,1),auxmat(1,1))
8526 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8527 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8528 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8529 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8530 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8531 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8532 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8533 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8534 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8535 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8536 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8537 call transpose2(AEA(1,1,2),auxmat(1,1))
8538 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8539 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8540 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8541 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8542 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8543 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8544 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8545 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8546 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8547 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8548 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8549 C Calculate the Cartesian derivatives of the vectors.
8553 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8554 call matvec2(auxmat(1,1),b1(1,i),
8555 & AEAb1derx(1,lll,kkk,iii,1,1))
8556 call matvec2(auxmat(1,1),Ub2(1,i),
8557 & AEAb2derx(1,lll,kkk,iii,1,1))
8558 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8559 & AEAb1derx(1,lll,kkk,iii,2,1))
8560 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8561 & AEAb2derx(1,lll,kkk,iii,2,1))
8562 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8563 call matvec2(auxmat(1,1),b1(1,l),
8564 & AEAb1derx(1,lll,kkk,iii,1,2))
8565 call matvec2(auxmat(1,1),Ub2(1,l),
8566 & AEAb2derx(1,lll,kkk,iii,1,2))
8567 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8568 & AEAb1derx(1,lll,kkk,iii,2,2))
8569 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8570 & AEAb2derx(1,lll,kkk,iii,2,2))
8579 C---------------------------------------------------------------------------
8580 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8581 & KK,KKderg,AKA,AKAderg,AKAderx)
8585 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8586 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8587 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8592 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8594 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8597 cd if (lprn) write (2,*) 'In kernel'
8599 cd if (lprn) write (2,*) 'kkk=',kkk
8601 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8602 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8604 cd write (2,*) 'lll=',lll
8605 cd write (2,*) 'iii=1'
8607 cd write (2,'(3(2f10.5),5x)')
8608 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8611 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8612 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8614 cd write (2,*) 'lll=',lll
8615 cd write (2,*) 'iii=2'
8617 cd write (2,'(3(2f10.5),5x)')
8618 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8625 C---------------------------------------------------------------------------
8626 double precision function eello4(i,j,k,l,jj,kk)
8627 implicit real*8 (a-h,o-z)
8628 include 'DIMENSIONS'
8629 include 'DIMENSIONS.ZSCOPT'
8630 include 'COMMON.IOUNITS'
8631 include 'COMMON.CHAIN'
8632 include 'COMMON.DERIV'
8633 include 'COMMON.INTERACT'
8634 include 'COMMON.CONTACTS'
8635 include 'COMMON.TORSION'
8636 include 'COMMON.VAR'
8637 include 'COMMON.GEO'
8638 double precision pizda(2,2),ggg1(3),ggg2(3)
8639 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8643 cd print *,'eello4:',i,j,k,l,jj,kk
8644 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8645 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8646 cold eij=facont_hb(jj,i)
8647 cold ekl=facont_hb(kk,k)
8649 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8651 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8652 gcorr_loc(k-1)=gcorr_loc(k-1)
8653 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8655 gcorr_loc(l-1)=gcorr_loc(l-1)
8656 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8658 gcorr_loc(j-1)=gcorr_loc(j-1)
8659 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8664 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8665 & -EAEAderx(2,2,lll,kkk,iii,1)
8666 cd derx(lll,kkk,iii)=0.0d0
8670 cd gcorr_loc(l-1)=0.0d0
8671 cd gcorr_loc(j-1)=0.0d0
8672 cd gcorr_loc(k-1)=0.0d0
8674 cd write (iout,*)'Contacts have occurred for peptide groups',
8675 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8676 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8677 if (j.lt.nres-1) then
8684 if (l.lt.nres-1) then
8692 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8693 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8694 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8695 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8696 cgrad ghalf=0.5d0*ggg1(ll)
8697 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8698 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8699 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8700 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8701 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8702 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8703 cgrad ghalf=0.5d0*ggg2(ll)
8704 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8705 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8706 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8707 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8708 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8709 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8713 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8718 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8723 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8728 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8732 cd write (2,*) iii,gcorr_loc(iii)
8736 cd write (2,*) 'ekont',ekont
8737 cd write (iout,*) 'eello4',ekont*eel4
8740 C---------------------------------------------------------------------------
8741 double precision function eello5(i,j,k,l,jj,kk)
8742 implicit real*8 (a-h,o-z)
8743 include 'DIMENSIONS'
8744 include 'DIMENSIONS.ZSCOPT'
8745 include 'COMMON.IOUNITS'
8746 include 'COMMON.CHAIN'
8747 include 'COMMON.DERIV'
8748 include 'COMMON.INTERACT'
8749 include 'COMMON.CONTACTS'
8750 include 'COMMON.TORSION'
8751 include 'COMMON.VAR'
8752 include 'COMMON.GEO'
8753 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8754 double precision ggg1(3),ggg2(3)
8755 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8760 C /l\ / \ \ / \ / \ / C
8761 C / \ / \ \ / \ / \ / C
8762 C j| o |l1 | o | o| o | | o |o C
8763 C \ |/k\| |/ \| / |/ \| |/ \| C
8764 C \i/ \ / \ / / \ / \ C
8766 C (I) (II) (III) (IV) C
8768 C eello5_1 eello5_2 eello5_3 eello5_4 C
8770 C Antiparallel chains C
8773 C /j\ / \ \ / \ / \ / C
8774 C / \ / \ \ / \ / \ / C
8775 C j1| o |l | o | o| o | | o |o C
8776 C \ |/k\| |/ \| / |/ \| |/ \| C
8777 C \i/ \ / \ / / \ / \ C
8779 C (I) (II) (III) (IV) C
8781 C eello5_1 eello5_2 eello5_3 eello5_4 C
8783 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8785 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8786 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8791 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8793 itk=itype2loc(itype(k))
8794 itl=itype2loc(itype(l))
8795 itj=itype2loc(itype(j))
8800 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8801 cd & eel5_3_num,eel5_4_num)
8805 derx(lll,kkk,iii)=0.0d0
8809 cd eij=facont_hb(jj,i)
8810 cd ekl=facont_hb(kk,k)
8812 cd write (iout,*)'Contacts have occurred for peptide groups',
8813 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8815 C Contribution from the graph I.
8816 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8817 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8818 call transpose2(EUg(1,1,k),auxmat(1,1))
8819 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8820 vv(1)=pizda(1,1)-pizda(2,2)
8821 vv(2)=pizda(1,2)+pizda(2,1)
8822 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8823 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8825 C Explicit gradient in virtual-dihedral angles.
8826 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8827 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8828 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8829 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8830 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8831 vv(1)=pizda(1,1)-pizda(2,2)
8832 vv(2)=pizda(1,2)+pizda(2,1)
8833 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8834 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8835 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8836 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8837 vv(1)=pizda(1,1)-pizda(2,2)
8838 vv(2)=pizda(1,2)+pizda(2,1)
8840 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8841 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8842 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8844 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8845 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8846 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8848 C Cartesian gradient
8852 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8854 vv(1)=pizda(1,1)-pizda(2,2)
8855 vv(2)=pizda(1,2)+pizda(2,1)
8856 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8857 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8858 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8865 C Contribution from graph II
8866 call transpose2(EE(1,1,k),auxmat(1,1))
8867 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8868 vv(1)=pizda(1,1)+pizda(2,2)
8869 vv(2)=pizda(2,1)-pizda(1,2)
8870 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8871 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8873 C Explicit gradient in virtual-dihedral angles.
8874 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8875 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8876 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8877 vv(1)=pizda(1,1)+pizda(2,2)
8878 vv(2)=pizda(2,1)-pizda(1,2)
8880 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8881 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8882 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8884 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8885 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8886 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8888 C Cartesian gradient
8892 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8894 vv(1)=pizda(1,1)+pizda(2,2)
8895 vv(2)=pizda(2,1)-pizda(1,2)
8896 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8897 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8898 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8907 C Parallel orientation
8908 C Contribution from graph III
8909 call transpose2(EUg(1,1,l),auxmat(1,1))
8910 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8911 vv(1)=pizda(1,1)-pizda(2,2)
8912 vv(2)=pizda(1,2)+pizda(2,1)
8913 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8914 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8916 C Explicit gradient in virtual-dihedral angles.
8917 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8918 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8919 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8920 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8921 vv(1)=pizda(1,1)-pizda(2,2)
8922 vv(2)=pizda(1,2)+pizda(2,1)
8923 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8924 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8925 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8926 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8927 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8928 vv(1)=pizda(1,1)-pizda(2,2)
8929 vv(2)=pizda(1,2)+pizda(2,1)
8930 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8931 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8932 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8933 C Cartesian gradient
8937 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8939 vv(1)=pizda(1,1)-pizda(2,2)
8940 vv(2)=pizda(1,2)+pizda(2,1)
8941 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8942 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8943 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8948 C Contribution from graph IV
8950 call transpose2(EE(1,1,l),auxmat(1,1))
8951 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8952 vv(1)=pizda(1,1)+pizda(2,2)
8953 vv(2)=pizda(2,1)-pizda(1,2)
8954 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8955 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8956 C Explicit gradient in virtual-dihedral angles.
8957 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8958 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8959 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8960 vv(1)=pizda(1,1)+pizda(2,2)
8961 vv(2)=pizda(2,1)-pizda(1,2)
8962 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8963 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8964 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8965 C Cartesian gradient
8969 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8971 vv(1)=pizda(1,1)+pizda(2,2)
8972 vv(2)=pizda(2,1)-pizda(1,2)
8973 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8974 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8975 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8981 C Antiparallel orientation
8982 C Contribution from graph III
8984 call transpose2(EUg(1,1,j),auxmat(1,1))
8985 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8986 vv(1)=pizda(1,1)-pizda(2,2)
8987 vv(2)=pizda(1,2)+pizda(2,1)
8988 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8989 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8991 C Explicit gradient in virtual-dihedral angles.
8992 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8993 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8994 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8995 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8996 vv(1)=pizda(1,1)-pizda(2,2)
8997 vv(2)=pizda(1,2)+pizda(2,1)
8998 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8999 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9000 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9001 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9002 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9003 vv(1)=pizda(1,1)-pizda(2,2)
9004 vv(2)=pizda(1,2)+pizda(2,1)
9005 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9006 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9007 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9008 C Cartesian gradient
9012 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9014 vv(1)=pizda(1,1)-pizda(2,2)
9015 vv(2)=pizda(1,2)+pizda(2,1)
9016 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9017 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9018 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9024 C Contribution from graph IV
9026 call transpose2(EE(1,1,j),auxmat(1,1))
9027 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9028 vv(1)=pizda(1,1)+pizda(2,2)
9029 vv(2)=pizda(2,1)-pizda(1,2)
9030 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9031 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9033 C Explicit gradient in virtual-dihedral angles.
9034 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9035 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9036 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9037 vv(1)=pizda(1,1)+pizda(2,2)
9038 vv(2)=pizda(2,1)-pizda(1,2)
9039 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9040 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9041 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9042 C Cartesian gradient
9046 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9048 vv(1)=pizda(1,1)+pizda(2,2)
9049 vv(2)=pizda(2,1)-pizda(1,2)
9050 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9051 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9052 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9059 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9060 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9061 cd write (2,*) 'ijkl',i,j,k,l
9062 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9063 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9065 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9066 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9067 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9068 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9070 if (j.lt.nres-1) then
9077 if (l.lt.nres-1) then
9087 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9088 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9089 C summed up outside the subrouine as for the other subroutines
9090 C handling long-range interactions. The old code is commented out
9091 C with "cgrad" to keep track of changes.
9093 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9094 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9095 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9096 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9097 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9098 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9099 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9100 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9101 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9102 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9104 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9105 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9106 cgrad ghalf=0.5d0*ggg1(ll)
9108 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9109 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9110 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9111 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9112 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9113 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9114 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9115 cgrad ghalf=0.5d0*ggg2(ll)
9117 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9118 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9119 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9120 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9121 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9122 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9128 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9129 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9134 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9135 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9141 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9146 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9150 cd write (2,*) iii,g_corr5_loc(iii)
9153 cd write (2,*) 'ekont',ekont
9154 cd write (iout,*) 'eello5',ekont*eel5
9157 c--------------------------------------------------------------------------
9158 double precision function eello6(i,j,k,l,jj,kk)
9159 implicit real*8 (a-h,o-z)
9160 include 'DIMENSIONS'
9161 include 'DIMENSIONS.ZSCOPT'
9162 include 'COMMON.IOUNITS'
9163 include 'COMMON.CHAIN'
9164 include 'COMMON.DERIV'
9165 include 'COMMON.INTERACT'
9166 include 'COMMON.CONTACTS'
9167 include 'COMMON.TORSION'
9168 include 'COMMON.VAR'
9169 include 'COMMON.GEO'
9170 include 'COMMON.FFIELD'
9171 double precision ggg1(3),ggg2(3)
9172 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9177 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9185 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9186 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9190 derx(lll,kkk,iii)=0.0d0
9194 cd eij=facont_hb(jj,i)
9195 cd ekl=facont_hb(kk,k)
9201 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9202 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9203 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9204 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9205 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9206 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9208 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9209 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9210 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9211 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9212 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9213 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9217 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9219 C If turn contributions are considered, they will be handled separately.
9220 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9221 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9222 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9223 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9224 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9225 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9226 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9229 if (j.lt.nres-1) then
9236 if (l.lt.nres-1) then
9244 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9245 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9246 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9247 cgrad ghalf=0.5d0*ggg1(ll)
9249 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9250 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9251 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9252 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9253 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9254 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9255 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9256 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9257 cgrad ghalf=0.5d0*ggg2(ll)
9258 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9260 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9261 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9262 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9263 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9264 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9265 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9271 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9272 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9277 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9278 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9284 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9289 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9293 cd write (2,*) iii,g_corr6_loc(iii)
9296 cd write (2,*) 'ekont',ekont
9297 cd write (iout,*) 'eello6',ekont*eel6
9300 c--------------------------------------------------------------------------
9301 double precision function eello6_graph1(i,j,k,l,imat,swap)
9302 implicit real*8 (a-h,o-z)
9303 include 'DIMENSIONS'
9304 include 'DIMENSIONS.ZSCOPT'
9305 include 'COMMON.IOUNITS'
9306 include 'COMMON.CHAIN'
9307 include 'COMMON.DERIV'
9308 include 'COMMON.INTERACT'
9309 include 'COMMON.CONTACTS'
9310 include 'COMMON.TORSION'
9311 include 'COMMON.VAR'
9312 include 'COMMON.GEO'
9313 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9317 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9319 C Parallel Antiparallel C
9325 C \ j|/k\| / \ |/k\|l / C
9330 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9331 itk=itype2loc(itype(k))
9332 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9333 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9334 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9335 call transpose2(EUgC(1,1,k),auxmat(1,1))
9336 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9337 vv1(1)=pizda1(1,1)-pizda1(2,2)
9338 vv1(2)=pizda1(1,2)+pizda1(2,1)
9339 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9340 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9341 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9342 s5=scalar2(vv(1),Dtobr2(1,i))
9343 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9344 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9346 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9347 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9348 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9349 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9350 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9351 & +scalar2(vv(1),Dtobr2der(1,i)))
9352 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9353 vv1(1)=pizda1(1,1)-pizda1(2,2)
9354 vv1(2)=pizda1(1,2)+pizda1(2,1)
9355 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9356 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9358 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9359 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9360 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9361 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9362 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9364 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9365 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9366 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9367 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9368 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9370 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9371 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9372 vv1(1)=pizda1(1,1)-pizda1(2,2)
9373 vv1(2)=pizda1(1,2)+pizda1(2,1)
9374 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9375 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9376 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9377 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9386 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9387 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9388 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9389 call transpose2(EUgC(1,1,k),auxmat(1,1))
9390 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9392 vv1(1)=pizda1(1,1)-pizda1(2,2)
9393 vv1(2)=pizda1(1,2)+pizda1(2,1)
9394 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9395 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9396 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9397 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9398 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9399 s5=scalar2(vv(1),Dtobr2(1,i))
9400 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9407 c----------------------------------------------------------------------------
9408 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9409 implicit real*8 (a-h,o-z)
9410 include 'DIMENSIONS'
9411 include 'DIMENSIONS.ZSCOPT'
9412 include 'COMMON.IOUNITS'
9413 include 'COMMON.CHAIN'
9414 include 'COMMON.DERIV'
9415 include 'COMMON.INTERACT'
9416 include 'COMMON.CONTACTS'
9417 include 'COMMON.TORSION'
9418 include 'COMMON.VAR'
9419 include 'COMMON.GEO'
9421 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9422 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9425 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9427 C Parallel Antiparallel C
9433 C \ j|/k\| \ |/k\|l C
9438 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9439 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9440 C AL 7/4/01 s1 would occur in the sixth-order moment,
9441 C but not in a cluster cumulant
9443 s1=dip(1,jj,i)*dip(1,kk,k)
9445 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9446 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9447 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9448 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9449 call transpose2(EUg(1,1,k),auxmat(1,1))
9450 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9451 vv(1)=pizda(1,1)-pizda(2,2)
9452 vv(2)=pizda(1,2)+pizda(2,1)
9453 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9454 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9456 eello6_graph2=-(s1+s2+s3+s4)
9458 eello6_graph2=-(s2+s3+s4)
9461 C Derivatives in gamma(i-1)
9465 s1=dipderg(1,jj,i)*dip(1,kk,k)
9467 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9468 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9469 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9470 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9472 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9474 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9476 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9478 C Derivatives in gamma(k-1)
9480 s1=dip(1,jj,i)*dipderg(1,kk,k)
9482 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9483 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9484 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9485 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9486 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9487 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9488 vv(1)=pizda(1,1)-pizda(2,2)
9489 vv(2)=pizda(1,2)+pizda(2,1)
9490 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9492 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9494 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9496 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9497 C Derivatives in gamma(j-1) or gamma(l-1)
9500 s1=dipderg(3,jj,i)*dip(1,kk,k)
9502 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9503 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9504 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9505 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9506 vv(1)=pizda(1,1)-pizda(2,2)
9507 vv(2)=pizda(1,2)+pizda(2,1)
9508 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9511 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9513 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9516 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9517 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9519 C Derivatives in gamma(l-1) or gamma(j-1)
9522 s1=dip(1,jj,i)*dipderg(3,kk,k)
9524 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9525 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9526 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9527 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9528 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9529 vv(1)=pizda(1,1)-pizda(2,2)
9530 vv(2)=pizda(1,2)+pizda(2,1)
9531 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9534 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9536 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9539 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9540 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9542 C Cartesian derivatives.
9544 write (2,*) 'In eello6_graph2'
9546 write (2,*) 'iii=',iii
9548 write (2,*) 'kkk=',kkk
9550 write (2,'(3(2f10.5),5x)')
9551 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9561 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9563 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9566 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9568 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9569 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9571 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9572 call transpose2(EUg(1,1,k),auxmat(1,1))
9573 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9575 vv(1)=pizda(1,1)-pizda(2,2)
9576 vv(2)=pizda(1,2)+pizda(2,1)
9577 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9578 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9580 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9582 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9585 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9587 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9595 c----------------------------------------------------------------------------
9596 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9597 implicit real*8 (a-h,o-z)
9598 include 'DIMENSIONS'
9599 include 'DIMENSIONS.ZSCOPT'
9600 include 'COMMON.IOUNITS'
9601 include 'COMMON.CHAIN'
9602 include 'COMMON.DERIV'
9603 include 'COMMON.INTERACT'
9604 include 'COMMON.CONTACTS'
9605 include 'COMMON.TORSION'
9606 include 'COMMON.VAR'
9607 include 'COMMON.GEO'
9608 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9610 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9612 C Parallel Antiparallel C
9618 C j|/k\| / |/k\|l / C
9623 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9625 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9626 C energy moment and not to the cluster cumulant.
9627 iti=itortyp(itype(i))
9628 if (j.lt.nres-1) then
9629 itj1=itype2loc(itype(j+1))
9633 itk=itype2loc(itype(k))
9634 itk1=itype2loc(itype(k+1))
9635 if (l.lt.nres-1) then
9636 itl1=itype2loc(itype(l+1))
9641 s1=dip(4,jj,i)*dip(4,kk,k)
9643 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9644 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9645 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9646 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9647 call transpose2(EE(1,1,k),auxmat(1,1))
9648 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9649 vv(1)=pizda(1,1)+pizda(2,2)
9650 vv(2)=pizda(2,1)-pizda(1,2)
9651 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9652 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9653 cd & "sum",-(s2+s3+s4)
9655 eello6_graph3=-(s1+s2+s3+s4)
9657 eello6_graph3=-(s2+s3+s4)
9660 C Derivatives in gamma(k-1)
9662 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9663 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9664 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9665 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9666 C Derivatives in gamma(l-1)
9667 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9668 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9669 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9670 vv(1)=pizda(1,1)+pizda(2,2)
9671 vv(2)=pizda(2,1)-pizda(1,2)
9672 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9673 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9674 C Cartesian derivatives.
9680 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9682 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9685 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9687 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9688 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9690 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9691 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9693 vv(1)=pizda(1,1)+pizda(2,2)
9694 vv(2)=pizda(2,1)-pizda(1,2)
9695 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9697 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9699 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9702 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9704 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9706 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9713 c----------------------------------------------------------------------------
9714 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9715 implicit real*8 (a-h,o-z)
9716 include 'DIMENSIONS'
9717 include 'DIMENSIONS.ZSCOPT'
9718 include 'COMMON.IOUNITS'
9719 include 'COMMON.CHAIN'
9720 include 'COMMON.DERIV'
9721 include 'COMMON.INTERACT'
9722 include 'COMMON.CONTACTS'
9723 include 'COMMON.TORSION'
9724 include 'COMMON.VAR'
9725 include 'COMMON.GEO'
9726 include 'COMMON.FFIELD'
9727 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9728 & auxvec1(2),auxmat1(2,2)
9730 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9732 C Parallel Antiparallel C
9738 C \ j|/k\| \ |/k\|l C
9743 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9745 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9746 C energy moment and not to the cluster cumulant.
9747 cd write (2,*) 'eello_graph4: wturn6',wturn6
9748 iti=itype2loc(itype(i))
9749 itj=itype2loc(itype(j))
9750 if (j.lt.nres-1) then
9751 itj1=itype2loc(itype(j+1))
9755 itk=itype2loc(itype(k))
9756 if (k.lt.nres-1) then
9757 itk1=itype2loc(itype(k+1))
9761 itl=itype2loc(itype(l))
9762 if (l.lt.nres-1) then
9763 itl1=itype2loc(itype(l+1))
9767 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9768 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9769 cd & ' itl',itl,' itl1',itl1
9772 s1=dip(3,jj,i)*dip(3,kk,k)
9774 s1=dip(2,jj,j)*dip(2,kk,l)
9777 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9778 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9780 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9781 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9783 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9784 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9786 call transpose2(EUg(1,1,k),auxmat(1,1))
9787 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9788 vv(1)=pizda(1,1)-pizda(2,2)
9789 vv(2)=pizda(2,1)+pizda(1,2)
9790 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9791 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9793 eello6_graph4=-(s1+s2+s3+s4)
9795 eello6_graph4=-(s2+s3+s4)
9797 C Derivatives in gamma(i-1)
9802 s1=dipderg(2,jj,i)*dip(3,kk,k)
9804 s1=dipderg(4,jj,j)*dip(2,kk,l)
9807 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9809 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9810 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9812 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9813 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9815 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9816 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9817 cd write (2,*) 'turn6 derivatives'
9819 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9821 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9825 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9827 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9831 C Derivatives in gamma(k-1)
9834 s1=dip(3,jj,i)*dipderg(2,kk,k)
9836 s1=dip(2,jj,j)*dipderg(4,kk,l)
9839 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9840 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9842 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9843 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9845 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9846 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9848 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9849 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9850 vv(1)=pizda(1,1)-pizda(2,2)
9851 vv(2)=pizda(2,1)+pizda(1,2)
9852 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9853 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9855 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9857 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9861 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9863 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9866 C Derivatives in gamma(j-1) or gamma(l-1)
9867 if (l.eq.j+1 .and. l.gt.1) then
9868 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9869 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9870 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9871 vv(1)=pizda(1,1)-pizda(2,2)
9872 vv(2)=pizda(2,1)+pizda(1,2)
9873 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9874 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9875 else if (j.gt.1) then
9876 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9877 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9878 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9879 vv(1)=pizda(1,1)-pizda(2,2)
9880 vv(2)=pizda(2,1)+pizda(1,2)
9881 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9882 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9883 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9885 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9888 C Cartesian derivatives.
9895 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9897 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9901 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9903 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9907 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9909 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9911 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9912 & b1(1,j+1),auxvec(1))
9913 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9915 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9916 & b1(1,l+1),auxvec(1))
9917 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9919 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9921 vv(1)=pizda(1,1)-pizda(2,2)
9922 vv(2)=pizda(2,1)+pizda(1,2)
9923 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9925 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9927 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9930 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9933 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9936 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9938 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9940 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9944 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9946 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9949 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9951 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9960 c----------------------------------------------------------------------------
9961 double precision function eello_turn6(i,jj,kk)
9962 implicit real*8 (a-h,o-z)
9963 include 'DIMENSIONS'
9964 include 'DIMENSIONS.ZSCOPT'
9965 include 'COMMON.IOUNITS'
9966 include 'COMMON.CHAIN'
9967 include 'COMMON.DERIV'
9968 include 'COMMON.INTERACT'
9969 include 'COMMON.CONTACTS'
9970 include 'COMMON.TORSION'
9971 include 'COMMON.VAR'
9972 include 'COMMON.GEO'
9973 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9974 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9976 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9977 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9978 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9979 C the respective energy moment and not to the cluster cumulant.
9988 iti=itype2loc(itype(i))
9989 itk=itype2loc(itype(k))
9990 itk1=itype2loc(itype(k+1))
9991 itl=itype2loc(itype(l))
9992 itj=itype2loc(itype(j))
9993 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9994 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9995 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10000 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10002 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10006 derx_turn(lll,kkk,iii)=0.0d0
10013 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10015 cd write (2,*) 'eello6_5',eello6_5
10017 call transpose2(AEA(1,1,1),auxmat(1,1))
10018 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10019 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10020 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10022 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10023 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10024 s2 = scalar2(b1(1,k),vtemp1(1))
10026 call transpose2(AEA(1,1,2),atemp(1,1))
10027 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10028 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
10029 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
10031 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10032 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10033 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10035 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10036 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10037 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10038 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10039 ss13 = scalar2(b1(1,k),vtemp4(1))
10040 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10042 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10048 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10049 C Derivatives in gamma(i+2)
10050 if (calc_grad) then
10054 call transpose2(AEA(1,1,1),auxmatd(1,1))
10055 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10056 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10057 call transpose2(AEAderg(1,1,2),atempd(1,1))
10058 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10059 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
10061 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10062 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10063 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10069 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10070 C Derivatives in gamma(i+3)
10072 call transpose2(AEA(1,1,1),auxmatd(1,1))
10073 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10074 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10075 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10077 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10078 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10079 s2d = scalar2(b1(1,k),vtemp1d(1))
10081 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
10082 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
10084 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10086 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10087 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10088 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10096 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10097 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10099 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10100 & -0.5d0*ekont*(s2d+s12d)
10102 C Derivatives in gamma(i+4)
10103 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10104 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10105 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10107 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10108 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10109 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10117 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10119 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10121 C Derivatives in gamma(i+5)
10123 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10124 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10125 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10127 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10128 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10129 s2d = scalar2(b1(1,k),vtemp1d(1))
10131 call transpose2(AEA(1,1,2),atempd(1,1))
10132 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10133 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
10135 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10136 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10138 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10139 ss13d = scalar2(b1(1,k),vtemp4d(1))
10140 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10148 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10149 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10151 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10152 & -0.5d0*ekont*(s2d+s12d)
10154 C Cartesian derivatives
10159 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10160 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10161 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10163 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10164 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10166 s2d = scalar2(b1(1,k),vtemp1d(1))
10168 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10169 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10170 s8d = -(atempd(1,1)+atempd(2,2))*
10171 & scalar2(cc(1,1,l),vtemp2(1))
10173 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10175 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10176 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10183 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10184 & - 0.5d0*(s1d+s2d)
10186 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10190 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10191 & - 0.5d0*(s8d+s12d)
10193 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10202 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10203 & achuj_tempd(1,1))
10204 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10205 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10206 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10207 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10208 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10210 ss13d = scalar2(b1(1,k),vtemp4d(1))
10211 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10212 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10216 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10217 cd & 16*eel_turn6_num
10219 if (j.lt.nres-1) then
10226 if (l.lt.nres-1) then
10234 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10235 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10236 cgrad ghalf=0.5d0*ggg1(ll)
10238 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10239 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10240 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10241 & +ekont*derx_turn(ll,2,1)
10242 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10243 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10244 & +ekont*derx_turn(ll,4,1)
10245 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10246 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10247 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10248 cgrad ghalf=0.5d0*ggg2(ll)
10250 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10251 & +ekont*derx_turn(ll,2,2)
10252 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10253 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10254 & +ekont*derx_turn(ll,4,2)
10255 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10256 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10257 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10262 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10267 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10273 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10278 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10282 cd write (2,*) iii,g_corr6_loc(iii)
10285 eello_turn6=ekont*eel_turn6
10286 cd write (2,*) 'ekont',ekont
10287 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10291 crc-------------------------------------------------
10292 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10293 subroutine Eliptransfer(eliptran)
10294 implicit real*8 (a-h,o-z)
10295 include 'DIMENSIONS'
10296 include 'DIMENSIONS.ZSCOPT'
10297 include 'COMMON.GEO'
10298 include 'COMMON.VAR'
10299 include 'COMMON.LOCAL'
10300 include 'COMMON.CHAIN'
10301 include 'COMMON.DERIV'
10302 include 'COMMON.INTERACT'
10303 include 'COMMON.IOUNITS'
10304 include 'COMMON.CALC'
10305 include 'COMMON.CONTROL'
10306 include 'COMMON.SPLITELE'
10307 include 'COMMON.SBRIDGE'
10308 C this is done by Adasko
10309 C print *,"wchodze"
10310 C structure of box:
10312 C--bordliptop-- buffore starts
10313 C--bufliptop--- here true lipid starts
10315 C--buflipbot--- lipid ends buffore starts
10316 C--bordlipbot--buffore ends
10320 if (itype(i).eq.ntyp1) cycle
10322 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10323 if (positi.le.0) positi=positi+boxzsize
10325 C first for peptide groups
10326 c for each residue check if it is in lipid or lipid water border area
10327 if ((positi.gt.bordlipbot)
10328 &.and.(positi.lt.bordliptop)) then
10329 C the energy transfer exist
10330 if (positi.lt.buflipbot) then
10331 C what fraction I am in
10333 & ((positi-bordlipbot)/lipbufthick)
10334 C lipbufthick is thickenes of lipid buffore
10335 sslip=sscalelip(fracinbuf)
10336 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10337 eliptran=eliptran+sslip*pepliptran
10338 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10339 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10340 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10341 elseif (positi.gt.bufliptop) then
10342 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10343 sslip=sscalelip(fracinbuf)
10344 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10345 eliptran=eliptran+sslip*pepliptran
10346 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10347 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10348 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10349 C print *, "doing sscalefor top part"
10350 C print *,i,sslip,fracinbuf,ssgradlip
10352 eliptran=eliptran+pepliptran
10353 C print *,"I am in true lipid"
10356 C eliptran=elpitran+0.0 ! I am in water
10359 C print *, "nic nie bylo w lipidzie?"
10360 C now multiply all by the peptide group transfer factor
10361 C eliptran=eliptran*pepliptran
10362 C now the same for side chains
10365 if (itype(i).eq.ntyp1) cycle
10366 positi=(mod(c(3,i+nres),boxzsize))
10367 if (positi.le.0) positi=positi+boxzsize
10368 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10369 c for each residue check if it is in lipid or lipid water border area
10370 C respos=mod(c(3,i+nres),boxzsize)
10371 C print *,positi,bordlipbot,buflipbot
10372 if ((positi.gt.bordlipbot)
10373 & .and.(positi.lt.bordliptop)) then
10374 C the energy transfer exist
10375 if (positi.lt.buflipbot) then
10377 & ((positi-bordlipbot)/lipbufthick)
10378 C lipbufthick is thickenes of lipid buffore
10379 sslip=sscalelip(fracinbuf)
10380 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10381 eliptran=eliptran+sslip*liptranene(itype(i))
10382 gliptranx(3,i)=gliptranx(3,i)
10383 &+ssgradlip*liptranene(itype(i))
10384 gliptranc(3,i-1)= gliptranc(3,i-1)
10385 &+ssgradlip*liptranene(itype(i))
10386 C print *,"doing sccale for lower part"
10387 elseif (positi.gt.bufliptop) then
10389 &((bordliptop-positi)/lipbufthick)
10390 sslip=sscalelip(fracinbuf)
10391 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10392 eliptran=eliptran+sslip*liptranene(itype(i))
10393 gliptranx(3,i)=gliptranx(3,i)
10394 &+ssgradlip*liptranene(itype(i))
10395 gliptranc(3,i-1)= gliptranc(3,i-1)
10396 &+ssgradlip*liptranene(itype(i))
10397 C print *, "doing sscalefor top part",sslip,fracinbuf
10399 eliptran=eliptran+liptranene(itype(i))
10400 C print *,"I am in true lipid"
10402 endif ! if in lipid or buffor
10404 C eliptran=elpitran+0.0 ! I am in water
10410 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10412 SUBROUTINE MATVEC2(A1,V1,V2)
10413 implicit real*8 (a-h,o-z)
10414 include 'DIMENSIONS'
10415 DIMENSION A1(2,2),V1(2),V2(2)
10419 c 3 VI=VI+A1(I,K)*V1(K)
10423 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10424 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10429 C---------------------------------------
10430 SUBROUTINE MATMAT2(A1,A2,A3)
10431 implicit real*8 (a-h,o-z)
10432 include 'DIMENSIONS'
10433 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10434 c DIMENSION AI3(2,2)
10438 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10444 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10445 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10446 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10447 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10455 c-------------------------------------------------------------------------
10456 double precision function scalar2(u,v)
10458 double precision u(2),v(2)
10459 double precision sc
10461 scalar2=u(1)*v(1)+u(2)*v(2)
10465 C-----------------------------------------------------------------------------
10467 subroutine transpose2(a,at)
10469 double precision a(2,2),at(2,2)
10476 c--------------------------------------------------------------------------
10477 subroutine transpose(n,a,at)
10480 double precision a(n,n),at(n,n)
10488 C---------------------------------------------------------------------------
10489 subroutine prodmat3(a1,a2,kk,transp,prod)
10492 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10494 crc double precision auxmat(2,2),prod_(2,2)
10497 crc call transpose2(kk(1,1),auxmat(1,1))
10498 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10499 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10501 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10502 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10503 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10504 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10505 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10506 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10507 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10508 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10511 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10512 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10514 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10515 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10516 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10517 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10518 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10519 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10520 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10521 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10524 c call transpose2(a2(1,1),a2t(1,1))
10527 crc print *,((prod_(i,j),i=1,2),j=1,2)
10528 crc print *,((prod(i,j),i=1,2),j=1,2)
10532 C-----------------------------------------------------------------------------
10533 double precision function scalar(u,v)
10535 double precision u(3),v(3)
10536 double precision sc
10545 C-----------------------------------------------------------------------
10546 double precision function sscale(r)
10547 double precision r,gamm
10548 include "COMMON.SPLITELE"
10549 if(r.lt.r_cut-rlamb) then
10551 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10552 gamm=(r-(r_cut-rlamb))/rlamb
10553 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10559 C-----------------------------------------------------------------------
10560 C-----------------------------------------------------------------------
10561 double precision function sscagrad(r)
10562 double precision r,gamm
10563 include "COMMON.SPLITELE"
10564 if(r.lt.r_cut-rlamb) then
10566 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10567 gamm=(r-(r_cut-rlamb))/rlamb
10568 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
10574 C-----------------------------------------------------------------------
10575 C-----------------------------------------------------------------------
10576 double precision function sscalelip(r)
10577 double precision r,gamm
10578 include "COMMON.SPLITELE"
10579 C if(r.lt.r_cut-rlamb) then
10581 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10582 C gamm=(r-(r_cut-rlamb))/rlamb
10583 sscalelip=1.0d0+r*r*(2*r-3.0d0)
10589 C-----------------------------------------------------------------------
10590 double precision function sscagradlip(r)
10591 double precision r,gamm
10592 include "COMMON.SPLITELE"
10593 C if(r.lt.r_cut-rlamb) then
10595 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10596 C gamm=(r-(r_cut-rlamb))/rlamb
10597 sscagradlip=r*(6*r-6.0d0)
10604 C-----------------------------------------------------------------------
10605 subroutine set_shield_fac
10606 implicit real*8 (a-h,o-z)
10607 include 'DIMENSIONS'
10608 include 'DIMENSIONS.ZSCOPT'
10609 include 'COMMON.CHAIN'
10610 include 'COMMON.DERIV'
10611 include 'COMMON.IOUNITS'
10612 include 'COMMON.SHIELD'
10613 include 'COMMON.INTERACT'
10614 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10615 double precision div77_81/0.974996043d0/,
10616 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10618 C the vector between center of side_chain and peptide group
10619 double precision pep_side(3),long,side_calf(3),
10620 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10621 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10622 C the line belowe needs to be changed for FGPROC>1
10624 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10626 Cif there two consequtive dummy atoms there is no peptide group between them
10627 C the line below has to be changed for FGPROC>1
10630 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10634 C first lets set vector conecting the ithe side-chain with kth side-chain
10635 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10636 C pep_side(j)=2.0d0
10637 C and vector conecting the side-chain with its proper calfa
10638 side_calf(j)=c(j,k+nres)-c(j,k)
10639 C side_calf(j)=2.0d0
10640 pept_group(j)=c(j,i)-c(j,i+1)
10641 C lets have their lenght
10642 dist_pep_side=pep_side(j)**2+dist_pep_side
10643 dist_side_calf=dist_side_calf+side_calf(j)**2
10644 dist_pept_group=dist_pept_group+pept_group(j)**2
10646 dist_pep_side=dsqrt(dist_pep_side)
10647 dist_pept_group=dsqrt(dist_pept_group)
10648 dist_side_calf=dsqrt(dist_side_calf)
10650 pep_side_norm(j)=pep_side(j)/dist_pep_side
10651 side_calf_norm(j)=dist_side_calf
10653 C now sscale fraction
10654 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10655 C print *,buff_shield,"buff"
10657 if (sh_frac_dist.le.0.0) cycle
10658 C If we reach here it means that this side chain reaches the shielding sphere
10659 C Lets add him to the list for gradient
10660 ishield_list(i)=ishield_list(i)+1
10661 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10662 C this list is essential otherwise problem would be O3
10663 shield_list(ishield_list(i),i)=k
10664 C Lets have the sscale value
10665 if (sh_frac_dist.gt.1.0) then
10666 scale_fac_dist=1.0d0
10668 sh_frac_dist_grad(j)=0.0d0
10671 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10672 & *(2.0*sh_frac_dist-3.0d0)
10673 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
10674 & /dist_pep_side/buff_shield*0.5
10675 C remember for the final gradient multiply sh_frac_dist_grad(j)
10676 C for side_chain by factor -2 !
10678 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10679 C print *,"jestem",scale_fac_dist,fac_help_scale,
10680 C & sh_frac_dist_grad(j)
10683 C if ((i.eq.3).and.(k.eq.2)) then
10684 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
10688 C this is what is now we have the distance scaling now volume...
10689 short=short_r_sidechain(itype(k))
10690 long=long_r_sidechain(itype(k))
10691 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
10694 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
10695 C costhet_fac=0.0d0
10697 costhet_grad(j)=costhet_fac*pep_side(j)
10699 C remember for the final gradient multiply costhet_grad(j)
10700 C for side_chain by factor -2 !
10701 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10702 C pep_side0pept_group is vector multiplication
10703 pep_side0pept_group=0.0
10705 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10707 cosalfa=(pep_side0pept_group/
10708 & (dist_pep_side*dist_side_calf))
10709 fac_alfa_sin=1.0-cosalfa**2
10710 fac_alfa_sin=dsqrt(fac_alfa_sin)
10711 rkprim=fac_alfa_sin*(long-short)+short
10713 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
10714 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
10717 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10718 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10719 &*(long-short)/fac_alfa_sin*cosalfa/
10720 &((dist_pep_side*dist_side_calf))*
10721 &((side_calf(j))-cosalfa*
10722 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10724 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10725 &*(long-short)/fac_alfa_sin*cosalfa
10726 &/((dist_pep_side*dist_side_calf))*
10728 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10731 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10734 C now the gradient...
10735 C grad_shield is gradient of Calfa for peptide groups
10736 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
10738 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
10739 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
10741 grad_shield(j,i)=grad_shield(j,i)
10742 C gradient po skalowaniu
10743 & +(sh_frac_dist_grad(j)
10744 C gradient po costhet
10745 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10746 &-scale_fac_dist*(cosphi_grad_long(j))
10747 &/(1.0-cosphi) )*div77_81
10749 C grad_shield_side is Cbeta sidechain gradient
10750 grad_shield_side(j,ishield_list(i),i)=
10751 & (sh_frac_dist_grad(j)*-2.0d0
10752 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10753 & +scale_fac_dist*(cosphi_grad_long(j))
10754 & *2.0d0/(1.0-cosphi))
10755 & *div77_81*VofOverlap
10757 grad_shield_loc(j,ishield_list(i),i)=
10758 & scale_fac_dist*cosphi_grad_loc(j)
10759 & *2.0d0/(1.0-cosphi)
10760 & *div77_81*VofOverlap
10762 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10764 fac_shield(i)=VolumeTotal*div77_81+div4_81
10765 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10769 C--------------------------------------------------------------------------
10770 C first for shielding is setting of function of side-chains
10771 subroutine set_shield_fac2
10772 implicit real*8 (a-h,o-z)
10773 include 'DIMENSIONS'
10774 include 'DIMENSIONS.ZSCOPT'
10775 include 'COMMON.CHAIN'
10776 include 'COMMON.DERIV'
10777 include 'COMMON.IOUNITS'
10778 include 'COMMON.SHIELD'
10779 include 'COMMON.INTERACT'
10780 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10781 double precision div77_81/0.974996043d0/,
10782 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10784 C the vector between center of side_chain and peptide group
10785 double precision pep_side(3),long,side_calf(3),
10786 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10787 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10788 C the line belowe needs to be changed for FGPROC>1
10790 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10792 Cif there two consequtive dummy atoms there is no peptide group between them
10793 C the line below has to be changed for FGPROC>1
10796 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10800 C first lets set vector conecting the ithe side-chain with kth side-chain
10801 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10802 C pep_side(j)=2.0d0
10803 C and vector conecting the side-chain with its proper calfa
10804 side_calf(j)=c(j,k+nres)-c(j,k)
10805 C side_calf(j)=2.0d0
10806 pept_group(j)=c(j,i)-c(j,i+1)
10807 C lets have their lenght
10808 dist_pep_side=pep_side(j)**2+dist_pep_side
10809 dist_side_calf=dist_side_calf+side_calf(j)**2
10810 dist_pept_group=dist_pept_group+pept_group(j)**2
10812 dist_pep_side=dsqrt(dist_pep_side)
10813 dist_pept_group=dsqrt(dist_pept_group)
10814 dist_side_calf=dsqrt(dist_side_calf)
10816 pep_side_norm(j)=pep_side(j)/dist_pep_side
10817 side_calf_norm(j)=dist_side_calf
10819 C now sscale fraction
10820 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10821 C print *,buff_shield,"buff"
10823 if (sh_frac_dist.le.0.0) cycle
10824 C If we reach here it means that this side chain reaches the shielding sphere
10825 C Lets add him to the list for gradient
10826 ishield_list(i)=ishield_list(i)+1
10827 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10828 C this list is essential otherwise problem would be O3
10829 shield_list(ishield_list(i),i)=k
10830 C Lets have the sscale value
10831 if (sh_frac_dist.gt.1.0) then
10832 scale_fac_dist=1.0d0
10834 sh_frac_dist_grad(j)=0.0d0
10837 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10838 & *(2.0d0*sh_frac_dist-3.0d0)
10839 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
10840 & /dist_pep_side/buff_shield*0.5d0
10841 C remember for the final gradient multiply sh_frac_dist_grad(j)
10842 C for side_chain by factor -2 !
10844 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10845 C sh_frac_dist_grad(j)=0.0d0
10846 C scale_fac_dist=1.0d0
10847 C print *,"jestem",scale_fac_dist,fac_help_scale,
10848 C & sh_frac_dist_grad(j)
10851 C this is what is now we have the distance scaling now volume...
10852 short=short_r_sidechain(itype(k))
10853 long=long_r_sidechain(itype(k))
10854 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
10855 sinthet=short/dist_pep_side*costhet
10859 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
10860 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
10861 C & -short/dist_pep_side**2/costhet)
10862 C costhet_fac=0.0d0
10864 costhet_grad(j)=costhet_fac*pep_side(j)
10866 C remember for the final gradient multiply costhet_grad(j)
10867 C for side_chain by factor -2 !
10868 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10869 C pep_side0pept_group is vector multiplication
10870 pep_side0pept_group=0.0d0
10872 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10874 cosalfa=(pep_side0pept_group/
10875 & (dist_pep_side*dist_side_calf))
10876 fac_alfa_sin=1.0d0-cosalfa**2
10877 fac_alfa_sin=dsqrt(fac_alfa_sin)
10878 rkprim=fac_alfa_sin*(long-short)+short
10882 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
10884 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
10885 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
10886 & dist_pep_side**2)
10889 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10890 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10891 &*(long-short)/fac_alfa_sin*cosalfa/
10892 &((dist_pep_side*dist_side_calf))*
10893 &((side_calf(j))-cosalfa*
10894 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10895 C cosphi_grad_long(j)=0.0d0
10896 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10897 &*(long-short)/fac_alfa_sin*cosalfa
10898 &/((dist_pep_side*dist_side_calf))*
10900 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10901 C cosphi_grad_loc(j)=0.0d0
10903 C print *,sinphi,sinthet
10904 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
10907 C now the gradient...
10909 grad_shield(j,i)=grad_shield(j,i)
10910 C gradient po skalowaniu
10911 & +(sh_frac_dist_grad(j)*VofOverlap
10912 C gradient po costhet
10913 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
10914 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10915 & sinphi/sinthet*costhet*costhet_grad(j)
10916 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10918 C grad_shield_side is Cbeta sidechain gradient
10919 grad_shield_side(j,ishield_list(i),i)=
10920 & (sh_frac_dist_grad(j)*-2.0d0
10922 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10923 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10924 & sinphi/sinthet*costhet*costhet_grad(j)
10925 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10928 grad_shield_loc(j,ishield_list(i),i)=
10929 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10930 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
10931 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
10935 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10937 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
10938 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10939 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
10943 C--------------------------------------------------------------------------
10944 double precision function tschebyshev(m,n,x,y)
10946 include "DIMENSIONS"
10948 double precision x(n),y,yy(0:maxvar),aux
10949 c Tschebyshev polynomial. Note that the first term is omitted
10950 c m=0: the constant term is included
10951 c m=1: the constant term is not included
10955 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
10964 C--------------------------------------------------------------------------
10965 double precision function gradtschebyshev(m,n,x,y)
10967 include "DIMENSIONS"
10969 double precision x(n+1),y,yy(0:maxvar),aux
10970 c Tschebyshev polynomial. Note that the first term is omitted
10971 c m=0: the constant term is included
10972 c m=1: the constant term is not included
10976 yy(i)=2*y*yy(i-1)-yy(i-2)
10980 aux=aux+x(i+1)*yy(i)*(i+1)
10981 C print *, x(i+1),yy(i),i
10983 gradtschebyshev=aux