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.
953 dxi=dc_norm(1,nres+i)
954 dyi=dc_norm(2,nres+i)
955 dzi=dc_norm(3,nres+i)
956 dsci_inv=vbld_inv(i+nres)
958 C Calculate SC interaction energy.
961 do j=istart(i,iint),iend(i,iint)
964 dscj_inv=vbld_inv(j+nres)
965 sig0ij=sigma(itypi,itypj)
966 chi1=chi(itypi,itypj)
967 chi2=chi(itypj,itypi)
974 alf12=0.5D0*(alf1+alf2)
975 C For diagnostics only!!!
988 dxj=dc_norm(1,nres+j)
989 dyj=dc_norm(2,nres+j)
990 dzj=dc_norm(3,nres+j)
991 c write (iout,*) i,j,xj,yj,zj
992 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
994 C Calculate angle-dependent terms of energy and contributions to their
998 sig=sig0ij*dsqrt(sigsq)
999 rij_shift=1.0D0/rij-sig+sig0ij
1000 C I hate to put IF's in the loops, but here don't have another choice!!!!
1001 if (rij_shift.le.0.0D0) then
1006 c---------------------------------------------------------------
1007 rij_shift=1.0D0/rij_shift
1008 fac=rij_shift**expon
1009 e1=fac*fac*aa(itypi,itypj)
1010 e2=fac*bb(itypi,itypj)
1011 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1012 eps2der=evdwij*eps3rt
1013 eps3der=evdwij*eps2rt
1014 evdwij=evdwij*eps2rt*eps3rt
1016 ij=icant(itypi,itypj)
1017 aux=eps1*eps2rt**2*eps3rt**2
1018 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1019 c & /dabs(eps(itypi,itypj))
1020 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1021 c-----------------------
1022 eps0ij=eps(itypi,itypj)
1023 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1/ftune_eps(eps0ij)
1024 rr0ij=r0(itypi,itypj)
1025 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps0ij
1026 c eneps_temp(2,ij)=eneps_temp(2,ij)+(rij_shift*rr0ij)**expon
1027 c-----------------------
1028 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1029 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1030 c & aux*e2/eps(itypi,itypj)
1032 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1033 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1034 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1035 & restyp(itypi),i,restyp(itypj),j,
1036 & epsi,sigm,chi1,chi2,chip1,chip2,
1037 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1038 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1042 C Calculate gradient components.
1043 e1=e1*eps1*eps2rt**2*eps3rt**2
1044 fac=-expon*(e1+evdwij)*rij_shift
1047 C Calculate the radial part of the gradient
1051 C Calculate angular part of the gradient.
1059 C-----------------------------------------------------------------------------
1060 subroutine egbv(evdw)
1062 C This subroutine calculates the interaction energy of nonbonded side chains
1063 C assuming the Gay-Berne-Vorobjev potential of interaction.
1065 implicit real*8 (a-h,o-z)
1066 include 'DIMENSIONS'
1067 include 'DIMENSIONS.ZSCOPT'
1068 include 'COMMON.GEO'
1069 include 'COMMON.VAR'
1070 include 'COMMON.LOCAL'
1071 include 'COMMON.CHAIN'
1072 include 'COMMON.DERIV'
1073 include 'COMMON.NAMES'
1074 include 'COMMON.INTERACT'
1075 include 'COMMON.WEIGHTDER'
1076 include 'COMMON.IOUNITS'
1077 include 'COMMON.CALC'
1078 common /srutu/ icall
1084 eneps_temp(j,i)=0.0d0
1088 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1091 c if (icall.gt.0) lprn=.true.
1093 do i=iatsc_s,iatsc_e
1099 dxi=dc_norm(1,nres+i)
1100 dyi=dc_norm(2,nres+i)
1101 dzi=dc_norm(3,nres+i)
1102 dsci_inv=vbld_inv(i+nres)
1104 C Calculate SC interaction energy.
1106 do iint=1,nint_gr(i)
1107 do j=istart(i,iint),iend(i,iint)
1110 dscj_inv=vbld_inv(j+nres)
1111 sig0ij=sigma(itypi,itypj)
1112 r0ij=r0(itypi,itypj)
1113 chi1=chi(itypi,itypj)
1114 chi2=chi(itypj,itypi)
1121 alf12=0.5D0*(alf1+alf2)
1122 C For diagnostics only!!!
1135 dxj=dc_norm(1,nres+j)
1136 dyj=dc_norm(2,nres+j)
1137 dzj=dc_norm(3,nres+j)
1138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1140 C Calculate angle-dependent terms of energy and contributions to their
1144 sig=sig0ij*dsqrt(sigsq)
1145 rij_shift=1.0D0/rij-sig+r0ij
1146 C I hate to put IF's in the loops, but here don't have another choice!!!!
1147 if (rij_shift.le.0.0D0) then
1152 c---------------------------------------------------------------
1153 rij_shift=1.0D0/rij_shift
1154 fac=rij_shift**expon
1155 e1=fac*fac*aa(itypi,itypj)
1156 e2=fac*bb(itypi,itypj)
1157 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1158 eps2der=evdwij*eps3rt
1159 eps3der=evdwij*eps2rt
1160 fac_augm=rrij**expon
1161 e_augm=augm(itypi,itypj)*fac_augm
1162 evdwij=evdwij*eps2rt*eps3rt
1163 evdw=evdw+evdwij+e_augm
1164 ij=icant(itypi,itypj)
1165 aux=eps1*eps2rt**2*eps3rt**2
1166 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1167 & /dabs(eps(itypi,itypj))
1168 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1169 c eneps_temp(ij)=eneps_temp(ij)
1170 c & +(evdwij+e_augm)/eps(itypi,itypj)
1172 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1173 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1174 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1175 c & restyp(itypi),i,restyp(itypj),j,
1176 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1177 c & chi1,chi2,chip1,chip2,
1178 c & eps1,eps2rt**2,eps3rt**2,
1179 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1183 C Calculate gradient components.
1184 e1=e1*eps1*eps2rt**2*eps3rt**2
1185 fac=-expon*(e1+evdwij)*rij_shift
1187 fac=rij*fac-2*expon*rrij*e_augm
1188 C Calculate the radial part of the gradient
1192 C Calculate angular part of the gradient.
1200 C-----------------------------------------------------------------------------
1201 SUBROUTINE emomo(evdw,evdw_p,evdw_m)
1203 C This subroutine calculates the interaction energy of nonbonded side chains
1204 C assuming the Gay-Berne potential of interaction.
1207 INCLUDE 'DIMENSIONS'
1208 INCLUDE 'DIMENSIONS.ZSCOPT'
1209 INCLUDE 'COMMON.CALC'
1210 INCLUDE 'COMMON.CONTROL'
1211 INCLUDE 'COMMON.CHAIN'
1212 INCLUDE 'COMMON.DERIV'
1213 INCLUDE 'COMMON.EMP'
1214 INCLUDE 'COMMON.GEO'
1215 INCLUDE 'COMMON.INTERACT'
1216 INCLUDE 'COMMON.IOUNITS'
1217 INCLUDE 'COMMON.LOCAL'
1218 INCLUDE 'COMMON.NAMES'
1219 INCLUDE 'COMMON.VAR'
1220 INCLUDE 'COMMON.WEIGHTDER'
1222 double precision scalar
1223 double precision ener(4)
1229 IF (energy_dec) write (iout,'(a)')
1230 & ' AAi i AAj j 1/rij Rtail Rhead evdwij Fcav Ecl
1231 & Egb Epol Fisocav Elj Equad evdw'
1236 ccccc energy_dec=.false.
1237 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1239 c if (icall.eq.0) lprn=.false.
1242 DO i = iatsc_s, iatsc_e
1244 c itypi1 = itype(i+1)
1245 dxi = dc_norm(1,nres+i)
1246 dyi = dc_norm(2,nres+i)
1247 dzi = dc_norm(3,nres+i)
1248 c dsci_inv=dsc_inv(itypi)
1249 dsci_inv = vbld_inv(i+nres)
1251 c ctail(k,1) = c(k, i+nres)
1252 c & - dtail(1,itypi,itypj) * dc_norm(k, nres+i)
1257 c!-------------------------------------------------------------------
1258 C Calculate SC interaction energy.
1259 DO iint = 1, nint_gr(i)
1260 DO j = istart(i,iint), iend(i,iint)
1261 c! initialize variables for electrostatic gradients
1262 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
1264 c dscj_inv = dsc_inv(itypj)
1265 dscj_inv = vbld_inv(j+nres)
1266 c! rij holds 1/(distance of Calpha atoms)
1267 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
1269 c!-------------------------------------------------------------------
1270 C Calculate angle-dependent terms of energy and contributions to their
1274 c! DO troll = 10, 5000
1278 c! sqom1 = om1 * om1
1279 c! sqom2 = om2 * om2
1280 c! sqom12 = om12 * om12
1281 c! rij = 5.0d0 / troll
1283 c! Rtail = troll / 5.0d0
1284 c! Rhead = troll / 5.0d0
1285 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1286 c! Rtail = dsqrt((Rtail**2)
1287 c! & +((dabs(dtail(1,itypi,itypj)-dtail(2,itypi,itypj)))**2))
1288 c! rij = 1.0d0/Rtail
1292 c! this should be in elgrad_init but om's are calculated by sc_angular
1293 c! which in turn is used by older potentials
1294 c! which proves how tangled UNRES code is >.<
1295 c! om = omega, sqom = om^2
1298 sqom12 = om12 * om12
1300 c! now we calculate EGB - Gey-Berne
1301 c! It will be summed up in evdwij and saved in evdw
1302 sigsq = 1.0D0 / sigsq
1303 sig = sig0ij * dsqrt(sigsq)
1304 c! rij_shift = 1.0D0 / rij - sig + sig0ij
1305 rij_shift = Rtail - sig + sig0ij
1306 IF (rij_shift.le.0.0D0) THEN
1310 sigder = -sig * sigsq
1311 rij_shift = 1.0D0 / rij_shift
1312 fac = rij_shift**expon
1313 c1 = fac * fac * aa(itypi,itypj)
1315 c2 = fac * bb(itypi,itypj)
1317 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
1318 eps2der = eps3rt * evdwij
1319 eps3der = eps2rt * evdwij
1320 c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
1321 evdwij = eps2rt * eps3rt * evdwij
1323 c! write (*,*) "Gey Berne = ", evdwij
1325 IF (bb(itypi,itypj).gt.0) THEN
1326 evdw_p = evdw_p + evdwij
1328 evdw_m = evdw_m + evdwij
1334 c!-------------------------------------------------------------------
1335 c! Calculate some components of GGB
1336 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
1337 fac = -expon * (c1 + evdwij) * rij_shift
1338 sigder = fac * sigder
1340 c! Calculate distance derivative
1347 c! write (*,*) "gg(1) = ", gg(1)
1348 c! write (*,*) "gg(2) = ", gg(2)
1349 c! write (*,*) "gg(3) = ", gg(3)
1350 c! The angular derivatives of GGB are brought together in sc_grad
1351 c!-------------------------------------------------------------------
1354 c! Catch gly-gly interactions to skip calculation of something that
1357 IF (itypi.eq.10.and.itypj.eq.10) THEN
1365 c! we are not 2 glycines, so we calculate Fcav (and maybe more)
1366 fac = chis1 * sqom1 + chis2 * sqom2
1367 & - 2.0d0 * chis12 * om1 * om2 * om12
1368 c! we will use pom later in Gcav, so dont mess with it!
1369 pom = 1.0d0 - chis1 * chis2 * sqom12
1371 Lambf = (1.0d0 - (fac / pom))
1372 Lambf = dsqrt(Lambf)
1375 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
1376 c! write (*,*) "sparrow = ", sparrow
1377 Chif = Rtail * sparrow
1378 ChiLambf = Chif * Lambf
1379 eagle = dsqrt(ChiLambf)
1380 bat = ChiLambf ** 11.0d0
1382 top = b1 * ( eagle + b2 * ChiLambf - b3 )
1383 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
1386 c! write (*,*) "sig1 = ",sig1
1387 c! write (*,*) "sig2 = ",sig2
1388 c! write (*,*) "Rtail = ",Rtail
1389 c! write (*,*) "sparrow = ",sparrow
1390 c! write (*,*) "Chis1 = ", chis1
1391 c! write (*,*) "Chis2 = ", chis2
1392 c! write (*,*) "Chis12 = ", chis12
1393 c! write (*,*) "om1 = ", om1
1394 c! write (*,*) "om2 = ", om2
1395 c! write (*,*) "om12 = ", om12
1396 c! write (*,*) "sqom1 = ", sqom1
1397 c! write (*,*) "sqom2 = ", sqom2
1398 c! write (*,*) "sqom12 = ", sqom12
1399 c! write (*,*) "Lambf = ",Lambf
1400 c! write (*,*) "b1 = ",b1
1401 c! write (*,*) "b2 = ",b2
1402 c! write (*,*) "b3 = ",b3
1403 c! write (*,*) "b4 = ",b4
1404 c! write (*,*) "top = ",top
1405 c! write (*,*) "bot = ",bot
1408 c! write (*,*) "Fcav = ", Fcav
1409 c!-------------------------------------------------------------------
1410 c! derivative of Fcav is Gcav...
1411 c!---------------------------------------------------
1413 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
1414 dbot = 12.0d0 * b4 * bat * Lambf
1415 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
1417 c! write (*,*) "dFcav/dR = ", dFdR
1419 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
1420 dbot = 12.0d0 * b4 * bat * Chif
1422 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
1423 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
1424 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
1425 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
1427 dFdL = ((dtop * bot - top * dbot) / botsq)
1429 dCAVdOM1 = dFdL * ( dFdOM1 )
1430 dCAVdOM2 = dFdL * ( dFdOM2 )
1431 dCAVdOM12 = dFdL * ( dFdOM12 )
1432 c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1
1433 c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2
1434 c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12
1436 c!-------------------------------------------------------------------
1437 c! Finally, add the distance derivatives of GB and Fcav to gvdwc
1438 c! Pom is used here to project the gradient vector into
1439 c! cartesian coordinates and at the same time contains
1440 c! dXhb/dXsc derivative (for charged amino acids
1441 c! location of hydrophobic centre of interaction is not
1442 c! the same as geometric centre of side chain, this
1443 c! derivative takes that into account)
1444 c! derivatives of omega angles will be added in sc_grad
1447 ertail(k) = Rtail_distance(k)/Rtail
1449 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
1450 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
1451 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1452 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1454 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1455 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1456 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
1457 gvdwx(k,i) = gvdwx(k,i)
1458 & - (( dFdR + gg(k) ) * pom)
1459 c! & - ( dFdR * pom )
1460 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
1461 gvdwx(k,j) = gvdwx(k,j)
1462 & + (( dFdR + gg(k) ) * pom)
1463 c! & + ( dFdR * pom )
1465 gvdwc(k,i) = gvdwc(k,i)
1466 & - (( dFdR + gg(k) ) * ertail(k))
1467 c! & - ( dFdR * ertail(k))
1469 gvdwc(k,j) = gvdwc(k,j)
1470 & + (( dFdR + gg(k) ) * ertail(k))
1471 c! & + ( dFdR * ertail(k))
1474 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1475 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1478 c!-------------------------------------------------------------------
1479 c! Compute head-head and head-tail energies for each state
1481 isel = iabs(Qi) + iabs(Qj)
1483 c! No charges - do nothing
1486 ELSE IF (isel.eq.4) THEN
1487 c! Calculate dipole-dipole interactions
1491 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
1492 c! Charge-nonpolar interactions
1496 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
1497 c! Nonpolar-charge interactions
1501 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
1502 c! Charge-dipole interactions
1503 CALL eqd(ecl, elj, epol)
1504 eheadtail = ECL + elj + epol
1506 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
1507 c! Dipole-charge interactions
1508 CALL edq(ecl, elj, epol)
1509 eheadtail = ECL + elj + epol
1511 ELSE IF ((isel.eq.2.and.
1512 & iabs(Qi).eq.1).and.
1513 & nstate(itypi,itypj).eq.1) THEN
1514 c! Same charge-charge interaction ( +/+ or -/- )
1515 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
1516 eheadtail = ECL + Egb + Epol + Fisocav + Elj
1518 ELSE IF ((isel.eq.2.and.
1519 & iabs(Qi).eq.1).and.
1520 & nstate(itypi,itypj).ne.1) THEN
1521 c! Different charge-charge interaction ( +/- or -/+ )
1523 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1525 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
1526 c! write (*,*) "evdw = ", evdw
1527 c! write (*,*) "Fcav = ", Fcav
1528 c! write (*,*) "eheadtail = ", eheadtail
1532 ij=icant(itypi,itypj)
1533 eneps_temp(1,ij)=eneps_temp(1,ij)+evdwij
1534 eneps_temp(2,ij)=eneps_temp(2,ij)+Fcav
1535 eneps_temp(3,ij)=eheadtail
1536 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,9f16.7)')
1537 & restyp(itype(i)),i,restyp(itype(j)),j,
1538 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1540 IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
1541 & restyp(itype(i)),i,restyp(itype(j)),j,
1542 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1549 c!-------------------------------------------------------------------
1550 c! As all angular derivatives are done, now we sum them up,
1551 c! then transform and project into cartesian vectors and add to gvdwc
1552 c! We call sc_grad always, with the exception of +/- interaction.
1553 c! This is because energy_quad subroutine needs to handle
1554 c! this job in his own way.
1555 c! This IS probably not very efficient and SHOULD be optimised
1556 c! but it will require major restructurization of emomo
1557 c! so it will be left as it is for now
1558 c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj)
1559 IF (nstate(itypi,itypj).eq.1) THEN
1561 IF (bb(itypi,itypj).gt.0) THEN
1570 c!-------------------------------------------------------------------
1575 c write (iout,*) "Number of loop steps in EGB:",ind
1576 c energy_dec=.false.
1578 END SUBROUTINE emomo
1580 C-----------------------------------------------------------------------------
1581 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
1583 INCLUDE 'DIMENSIONS'
1584 INCLUDE 'DIMENSIONS.ZSCOPT'
1585 INCLUDE 'COMMON.CALC'
1586 INCLUDE 'COMMON.CHAIN'
1587 INCLUDE 'COMMON.CONTROL'
1588 INCLUDE 'COMMON.DERIV'
1589 INCLUDE 'COMMON.EMP'
1590 INCLUDE 'COMMON.GEO'
1591 INCLUDE 'COMMON.INTERACT'
1592 INCLUDE 'COMMON.IOUNITS'
1593 INCLUDE 'COMMON.LOCAL'
1594 INCLUDE 'COMMON.NAMES'
1595 INCLUDE 'COMMON.VAR'
1596 double precision scalar, facd3, facd4, federmaus, adler
1597 c! Epol and Gpol analytical parameters
1598 alphapol1 = alphapol(itypi,itypj)
1599 alphapol2 = alphapol(itypj,itypi)
1600 c! Fisocav and Gisocav analytical parameters
1601 al1 = alphiso(1,itypi,itypj)
1602 al2 = alphiso(2,itypi,itypj)
1603 al3 = alphiso(3,itypi,itypj)
1604 al4 = alphiso(4,itypi,itypj)
1606 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1607 & + sigiso2(itypi,itypj)**2.0d0))
1609 pis = sig0head(itypi,itypj)
1610 eps_head = epshead(itypi,itypj)
1611 Rhead_sq = Rhead * Rhead
1612 c! R1 - distance between head of ith side chain and tail of jth sidechain
1613 c! R2 - distance between head of jth side chain and tail of ith sidechain
1617 c! Calculate head-to-tail distances needed by Epol
1618 R1=R1+(ctail(k,2)-chead(k,1))**2
1619 R2=R2+(chead(k,2)-ctail(k,1))**2
1625 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1626 c! & +dhead(1,1,itypi,itypj))**2))
1627 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1628 c! & +dhead(2,1,itypi,itypj))**2))
1629 c!-------------------------------------------------------------------
1630 c! Coulomb electrostatic interaction
1631 Ecl = (332.0d0 * Qij) / Rhead
1632 c! derivative of Ecl is Gcl...
1633 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
1637 c!-------------------------------------------------------------------
1638 c! Generalised Born Solvent Polarization
1639 c! Charged head polarizes the solvent
1640 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1641 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1642 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1643 c! Derivative of Egb is Ggb...
1644 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1645 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1647 dGGBdR = dGGBdFGB * dFGBdR
1648 c!-------------------------------------------------------------------
1649 c! Fisocav - isotropic cavity creation term
1650 c! or "how much energy it costs to put charged head in water"
1652 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1653 bot = (1.0d0 + al4 * pom**12.0d0)
1656 c! write (*,*) "Rhead = ",Rhead
1657 c! write (*,*) "csig = ",csig
1658 c! write (*,*) "pom = ",pom
1659 c! write (*,*) "al1 = ",al1
1660 c! write (*,*) "al2 = ",al2
1661 c! write (*,*) "al3 = ",al3
1662 c! write (*,*) "al4 = ",al4
1663 c! write (*,*) "top = ",top
1664 c! write (*,*) "bot = ",bot
1665 c! Derivative of Fisocav is GCV...
1666 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1667 dbot = 12.0d0 * al4 * pom ** 11.0d0
1668 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1669 c!-------------------------------------------------------------------
1671 c! Polarization energy - charged heads polarize hydrophobic "neck"
1672 MomoFac1 = (1.0d0 - chi1 * sqom2)
1673 MomoFac2 = (1.0d0 - chi2 * sqom1)
1674 RR1 = ( R1 * R1 ) / MomoFac1
1675 RR2 = ( R2 * R2 ) / MomoFac2
1676 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1677 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1678 fgb1 = sqrt( RR1 + a12sq * ee1 )
1679 fgb2 = sqrt( RR2 + a12sq * ee2 )
1680 epol = 332.0d0 * eps_inout_fac * (
1681 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1683 c write (*,*) "eps_inout_fac = ",eps_inout_fac
1684 c write (*,*) "alphapol1 = ", alphapol1
1685 c write (*,*) "alphapol2 = ", alphapol2
1686 c write (*,*) "fgb1 = ", fgb1
1687 c write (*,*) "fgb2 = ", fgb2
1688 c write (*,*) "epol = ", epol
1689 c! derivative of Epol is Gpol...
1690 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1692 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1694 dFGBdR1 = ( (R1 / MomoFac1)
1695 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1696 & / ( 2.0d0 * fgb1 )
1697 dFGBdR2 = ( (R2 / MomoFac2)
1698 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1699 & / ( 2.0d0 * fgb2 )
1700 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1701 & * ( 2.0d0 - 0.5d0 * ee1) )
1702 & / ( 2.0d0 * fgb1 )
1703 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1704 & * ( 2.0d0 - 0.5d0 * ee2) )
1705 & / ( 2.0d0 * fgb2 )
1706 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1708 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1710 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1712 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1714 c!-------------------------------------------------------------------
1716 c! Lennard-Jones 6-12 interaction between heads
1717 pom = (pis / Rhead)**6.0d0
1718 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1719 c! derivative of Elj is Glj
1720 dGLJdR = 4.0d0 * eps_head
1721 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1722 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1723 c!-------------------------------------------------------------------
1724 c! Return the results
1725 c! These things do the dRdX derivatives, that is
1726 c! allow us to change what we see from function that changes with
1727 c! distance to function that changes with LOCATION (of the interaction
1730 erhead(k) = Rhead_distance(k)/Rhead
1731 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1732 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1735 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1736 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1737 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1738 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1739 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1740 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1741 facd1 = d1 * vbld_inv(i+nres)
1742 facd2 = d2 * vbld_inv(j+nres)
1743 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1744 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1746 c! Now we add appropriate partial derivatives (one in each dimension)
1748 hawk = (erhead_tail(k,1) +
1749 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
1750 condor = (erhead_tail(k,2) +
1751 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
1753 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1754 gvdwx(k,i) = gvdwx(k,i)
1759 & - dPOLdR2 * (erhead_tail(k,2)
1760 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1763 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1764 gvdwx(k,j) = gvdwx(k,j)
1768 & + dPOLdR1 * (erhead_tail(k,1)
1769 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1770 & + dPOLdR2 * condor
1773 gvdwc(k,i) = gvdwc(k,i)
1774 & - dGCLdR * erhead(k)
1775 & - dGGBdR * erhead(k)
1776 & - dGCVdR * erhead(k)
1777 & - dPOLdR1 * erhead_tail(k,1)
1778 & - dPOLdR2 * erhead_tail(k,2)
1779 & - dGLJdR * erhead(k)
1781 gvdwc(k,j) = gvdwc(k,j)
1782 & + dGCLdR * erhead(k)
1783 & + dGGBdR * erhead(k)
1784 & + dGCVdR * erhead(k)
1785 & + dPOLdR1 * erhead_tail(k,1)
1786 & + dPOLdR2 * erhead_tail(k,2)
1787 & + dGLJdR * erhead(k)
1792 c!-------------------------------------------------------------------
1793 SUBROUTINE energy_quad
1794 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1796 INCLUDE 'DIMENSIONS'
1797 INCLUDE 'DIMENSIONS.ZSCOPT'
1798 INCLUDE 'COMMON.CALC'
1799 INCLUDE 'COMMON.CHAIN'
1800 INCLUDE 'COMMON.CONTROL'
1801 INCLUDE 'COMMON.DERIV'
1802 INCLUDE 'COMMON.EMP'
1803 INCLUDE 'COMMON.GEO'
1804 INCLUDE 'COMMON.INTERACT'
1805 INCLUDE 'COMMON.IOUNITS'
1806 INCLUDE 'COMMON.LOCAL'
1807 INCLUDE 'COMMON.NAMES'
1808 INCLUDE 'COMMON.VAR'
1809 double precision scalar
1810 double precision ener(4)
1811 double precision dcosom1(3),dcosom2(3)
1812 c! used in Epol derivatives
1813 double precision facd3, facd4
1814 double precision federmaus, adler
1815 c! Epol and Gpol analytical parameters
1816 alphapol1 = alphapol(itypi,itypj)
1817 alphapol2 = alphapol(itypj,itypi)
1818 c! Fisocav and Gisocav analytical parameters
1819 al1 = alphiso(1,itypi,itypj)
1820 al2 = alphiso(2,itypi,itypj)
1821 al3 = alphiso(3,itypi,itypj)
1822 al4 = alphiso(4,itypi,itypj)
1824 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1825 & + sigiso2(itypi,itypj)**2.0d0))
1827 w1 = wqdip(1,itypi,itypj)
1828 w2 = wqdip(2,itypi,itypj)
1829 pis = sig0head(itypi,itypj)
1830 eps_head = epshead(itypi,itypj)
1831 c! First things first:
1832 c! We need to do sc_grad's job with GB and Fcav
1834 & eps2der * eps2rt_om1
1835 & - 2.0D0 * alf1 * eps3der
1836 & + sigder * sigsq_om1
1839 & eps2der * eps2rt_om2
1840 & + 2.0D0 * alf2 * eps3der
1841 & + sigder * sigsq_om2
1844 & evdwij * eps1_om12
1845 & + eps2der * eps2rt_om12
1846 & - 2.0D0 * alf12 * eps3der
1847 & + sigder *sigsq_om12
1849 c! now some magical transformations to project gradient into
1850 c! three cartesian vectors
1852 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1853 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1854 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
1855 c! this acts on hydrophobic center of interaction
1856 gvdwx(k,i)= gvdwx(k,i) - gg(k)
1857 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1858 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1859 gvdwx(k,j)= gvdwx(k,j) + gg(k)
1860 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1861 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1862 c! this acts on Calpha
1863 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1864 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1866 c! sc_grad is done, now we will compute
1875 c! d1 = dhead(1, 1, itypi, itypj)
1876 c! d2 = dhead(2, 1, itypi, itypj)
1877 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1878 c! & +dhead(1,ii,itypi,itypj))**2))
1879 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1880 c! & +dhead(2,jj,itypi,itypj))**2))
1881 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1882 c! END OF ENERGY DEBUG
1883 c*************************************************************
1884 DO istate = 1, nstate(itypi,itypj)
1885 c*************************************************************
1886 IF (istate.ne.1) THEN
1887 IF (istate.lt.3) THEN
1893 d1 = dhead(1,ii,itypi,itypj)
1894 d2 = dhead(2,jj,itypi,itypj)
1896 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
1897 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
1898 Rhead_distance(k) = chead(k,2) - chead(k,1)
1900 c! pitagoras (root of sum of squares)
1902 & (Rhead_distance(1)*Rhead_distance(1))
1903 & + (Rhead_distance(2)*Rhead_distance(2))
1904 & + (Rhead_distance(3)*Rhead_distance(3)))
1906 Rhead_sq = Rhead * Rhead
1908 c! R1 - distance between head of ith side chain and tail of jth sidechain
1909 c! R2 - distance between head of jth side chain and tail of ith sidechain
1913 c! Calculate head-to-tail distances
1914 R1=R1+(ctail(k,2)-chead(k,1))**2
1915 R2=R2+(chead(k,2)-ctail(k,1))**2
1922 c! write (*,*) "istate = ", istate
1923 c! write (*,*) "ii = ", ii
1924 c! write (*,*) "jj = ", jj
1925 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1926 c! & +dhead(1,ii,itypi,itypj))**2))
1927 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1928 c! & +dhead(2,jj,itypi,itypj))**2))
1929 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1930 c! Rhead_sq = Rhead * Rhead
1931 c! write (*,*) "d1 = ",d1
1932 c! write (*,*) "d2 = ",d2
1933 c! write (*,*) "R1 = ",R1
1934 c! write (*,*) "R2 = ",R2
1935 c! write (*,*) "Rhead = ",Rhead
1936 c! END OF ENERGY DEBUG
1938 c!-------------------------------------------------------------------
1939 c! Coulomb electrostatic interaction
1940 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
1942 c! write (*,*) "Ecl = ", Ecl
1943 c! derivative of Ecl is Gcl...
1944 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
1949 c!-------------------------------------------------------------------
1950 c! Generalised Born Solvent Polarization
1951 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1952 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1953 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1955 c! write (*,*) "a1*a2 = ", a12sq
1956 c! write (*,*) "Rhead = ", Rhead
1957 c! write (*,*) "Rhead_sq = ", Rhead_sq
1958 c! write (*,*) "ee = ", ee
1959 c! write (*,*) "Fgb = ", Fgb
1960 c! write (*,*) "fac = ", eps_inout_fac
1961 c! write (*,*) "Qij = ", Qij
1962 c! write (*,*) "Egb = ", Egb
1963 c! Derivative of Egb is Ggb...
1964 c! dFGBdR is used by Quad's later...
1965 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1966 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1968 dGGBdR = dGGBdFGB * dFGBdR
1970 c!-------------------------------------------------------------------
1971 c! Fisocav - isotropic cavity creation term
1973 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1974 bot = (1.0d0 + al4 * pom**12.0d0)
1978 c! write (*,*) "pom = ",pom
1979 c! write (*,*) "al1 = ",al1
1980 c! write (*,*) "al2 = ",al2
1981 c! write (*,*) "al3 = ",al3
1982 c! write (*,*) "al4 = ",al4
1983 c! write (*,*) "top = ",top
1984 c! write (*,*) "bot = ",bot
1985 c! write (*,*) "Fisocav = ", Fisocav
1987 c! Derivative of Fisocav is GCV...
1988 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1989 dbot = 12.0d0 * al4 * pom ** 11.0d0
1990 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1992 c!-------------------------------------------------------------------
1993 c! Polarization energy
1995 MomoFac1 = (1.0d0 - chi1 * sqom2)
1996 MomoFac2 = (1.0d0 - chi2 * sqom1)
1997 RR1 = ( R1 * R1 ) / MomoFac1
1998 RR2 = ( R2 * R2 ) / MomoFac2
1999 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2000 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
2001 fgb1 = sqrt( RR1 + a12sq * ee1 )
2002 fgb2 = sqrt( RR2 + a12sq * ee2 )
2003 epol = 332.0d0 * eps_inout_fac * (
2004 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
2006 c! derivative of Epol is Gpol...
2007 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2009 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2011 dFGBdR1 = ( (R1 / MomoFac1)
2012 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2013 & / ( 2.0d0 * fgb1 )
2014 dFGBdR2 = ( (R2 / MomoFac2)
2015 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2016 & / ( 2.0d0 * fgb2 )
2017 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2018 & * ( 2.0d0 - 0.5d0 * ee1) )
2019 & / ( 2.0d0 * fgb1 )
2020 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2021 & * ( 2.0d0 - 0.5d0 * ee2) )
2022 & / ( 2.0d0 * fgb2 )
2023 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2025 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2027 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2029 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2031 c!-------------------------------------------------------------------
2033 pom = (pis / Rhead)**6.0d0
2034 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2036 c! derivative of Elj is Glj
2037 dGLJdR = 4.0d0 * eps_head
2038 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2039 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2041 c!-------------------------------------------------------------------
2043 IF (Wqd.ne.0.0d0) THEN
2044 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
2045 & - 37.5d0 * ( sqom1 + sqom2 )
2046 & + 157.5d0 * ( sqom1 * sqom2 )
2047 & - 45.0d0 * om1*om2*om12
2048 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
2051 c! derivative of Equad...
2052 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
2055 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
2056 c! dQUADdOM1 = 0.0d0
2058 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
2059 c! dQUADdOM2 = 0.0d0
2061 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
2062 c! dQUADdOM12 = 0.0d0
2067 c!-------------------------------------------------------------------
2068 c! Return the results
2070 eom1 = dPOLdOM1 + dQUADdOM1
2071 eom2 = dPOLdOM2 + dQUADdOM2
2073 c! now some magical transformations to project gradient into
2074 c! three cartesian vectors
2076 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
2077 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
2078 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
2082 erhead(k) = Rhead_distance(k)/Rhead
2083 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2084 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2086 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2087 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2088 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2089 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2090 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2091 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2092 facd1 = d1 * vbld_inv(i+nres)
2093 facd2 = d2 * vbld_inv(j+nres)
2094 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2095 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2096 c! Throw the results into gheadtail which holds gradients
2097 c! for each micro-state
2099 hawk = erhead_tail(k,1) +
2100 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
2101 condor = erhead_tail(k,2) +
2102 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
2104 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2105 c! this acts on hydrophobic center of interaction
2106 gheadtail(k,1,1) = gheadtail(k,1,1)
2111 & - dPOLdR2 * (erhead_tail(k,2)
2112 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2116 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2117 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2119 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2120 c! this acts on hydrophobic center of interaction
2121 gheadtail(k,2,1) = gheadtail(k,2,1)
2125 & + dPOLdR1 * (erhead_tail(k,1)
2126 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2127 & + dPOLdR2 * condor
2131 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2132 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2134 c! this acts on Calpha
2135 gheadtail(k,3,1) = gheadtail(k,3,1)
2136 & - dGCLdR * erhead(k)
2137 & - dGGBdR * erhead(k)
2138 & - dGCVdR * erhead(k)
2139 & - dPOLdR1 * erhead_tail(k,1)
2140 & - dPOLdR2 * erhead_tail(k,2)
2141 & - dGLJdR * erhead(k)
2142 & - dQUADdR * erhead(k)
2145 c! this acts on Calpha
2146 gheadtail(k,4,1) = gheadtail(k,4,1)
2147 & + dGCLdR * erhead(k)
2148 & + dGGBdR * erhead(k)
2149 & + dGCVdR * erhead(k)
2150 & + dPOLdR1 * erhead_tail(k,1)
2151 & + dPOLdR2 * erhead_tail(k,2)
2152 & + dGLJdR * erhead(k)
2153 & + dQUADdR * erhead(k)
2156 c! write(*,*) "ECL = ", Ecl
2157 c! write(*,*) "Egb = ", Egb
2158 c! write(*,*) "Epol = ", Epol
2159 c! write(*,*) "Fisocav = ", Fisocav
2160 c! write(*,*) "Elj = ", Elj
2161 c! write(*,*) "Equad = ", Equad
2162 c! write(*,*) "wstate = ", wstate(istate,itypi,itypj)
2163 c! write(*,*) "eheadtail = ", eheadtail
2164 c! write(*,*) "TROLL = ", dexp(-betaT * ener(istate))
2165 c! write(*,*) "dGCLdR = ", dGCLdR
2166 c! write(*,*) "dGGBdR = ", dGGBdR
2167 c! write(*,*) "dGCVdR = ", dGCVdR
2168 c! write(*,*) "dPOLdR1 = ", dPOLdR1
2169 c! write(*,*) "dPOLdR2 = ", dPOLdR2
2170 c! write(*,*) "dGLJdR = ", dGLJdR
2171 c! write(*,*) "dQUADdR = ", dQUADdR
2172 c! write(*,*) "tuna(",k,") = ", tuna(k)
2173 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
2174 eheadtail = eheadtail
2175 & + wstate(istate, itypi, itypj)
2176 & * dexp(-betaT * ener(istate))
2177 c! foreach cartesian dimension
2179 c! foreach of two gvdwx and gvdwc
2181 gheadtail(k,l,2) = gheadtail(k,l,2)
2182 & + wstate( istate, itypi, itypj )
2183 & * dexp(-betaT * ener(istate))
2184 & * gheadtail(k,l,1)
2185 gheadtail(k,l,1) = 0.0d0
2189 c! Here ended the gigantic DO istate = 1, 4, which starts
2190 c! at the beggining of the subroutine
2194 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
2196 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
2197 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
2198 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
2199 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
2201 gheadtail(k,l,1) = 0.0d0
2202 gheadtail(k,l,2) = 0.0d0
2205 eheadtail = (-dlog(eheadtail)) / betaT
2212 END SUBROUTINE energy_quad
2213 c!-------------------------------------------------------------------
2214 SUBROUTINE eqn(Epol)
2216 INCLUDE 'DIMENSIONS'
2217 INCLUDE 'DIMENSIONS.ZSCOPT'
2218 INCLUDE 'COMMON.CALC'
2219 INCLUDE 'COMMON.CHAIN'
2220 INCLUDE 'COMMON.CONTROL'
2221 INCLUDE 'COMMON.DERIV'
2222 INCLUDE 'COMMON.EMP'
2223 INCLUDE 'COMMON.GEO'
2224 INCLUDE 'COMMON.INTERACT'
2225 INCLUDE 'COMMON.IOUNITS'
2226 INCLUDE 'COMMON.LOCAL'
2227 INCLUDE 'COMMON.NAMES'
2228 INCLUDE 'COMMON.VAR'
2229 double precision scalar, facd4, federmaus
2230 alphapol1 = alphapol(itypi,itypj)
2231 c! R1 - distance between head of ith side chain and tail of jth sidechain
2234 c! Calculate head-to-tail distances
2235 R1=R1+(ctail(k,2)-chead(k,1))**2
2240 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2241 c! & +dhead(1,1,itypi,itypj))**2))
2242 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2243 c! & +dhead(2,1,itypi,itypj))**2))
2244 c--------------------------------------------------------------------
2245 c Polarization energy
2247 MomoFac1 = (1.0d0 - chi1 * sqom2)
2248 RR1 = R1 * R1 / MomoFac1
2249 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2250 fgb1 = sqrt( RR1 + a12sq * ee1)
2251 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2253 c!------------------------------------------------------------------
2254 c! derivative of Epol is Gpol...
2255 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2257 dFGBdR1 = ( (R1 / MomoFac1)
2258 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2259 & / ( 2.0d0 * fgb1 )
2260 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2261 & * (2.0d0 - 0.5d0 * ee1) )
2263 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2266 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2268 c!-------------------------------------------------------------------
2269 c! Return the results
2270 c! (see comments in Eqq)
2272 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2274 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2275 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2276 facd1 = d1 * vbld_inv(i+nres)
2277 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2280 hawk = (erhead_tail(k,1) +
2281 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2283 gvdwx(k,i) = gvdwx(k,i)
2285 gvdwx(k,j) = gvdwx(k,j)
2286 & + dPOLdR1 * (erhead_tail(k,1)
2287 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2289 gvdwc(k,i) = gvdwc(k,i)
2290 & - dPOLdR1 * erhead_tail(k,1)
2291 gvdwc(k,j) = gvdwc(k,j)
2292 & + dPOLdR1 * erhead_tail(k,1)
2299 c!-------------------------------------------------------------------
2303 SUBROUTINE enq(Epol)
2305 INCLUDE 'DIMENSIONS'
2306 INCLUDE 'DIMENSIONS.ZSCOPT'
2307 INCLUDE 'COMMON.CALC'
2308 INCLUDE 'COMMON.CHAIN'
2309 INCLUDE 'COMMON.CONTROL'
2310 INCLUDE 'COMMON.DERIV'
2311 INCLUDE 'COMMON.EMP'
2312 INCLUDE 'COMMON.GEO'
2313 INCLUDE 'COMMON.INTERACT'
2314 INCLUDE 'COMMON.IOUNITS'
2315 INCLUDE 'COMMON.LOCAL'
2316 INCLUDE 'COMMON.NAMES'
2317 INCLUDE 'COMMON.VAR'
2318 double precision scalar, facd3, adler
2319 alphapol2 = alphapol(itypj,itypi)
2320 c! R2 - distance between head of jth side chain and tail of ith sidechain
2323 c! Calculate head-to-tail distances
2324 R2=R2+(chead(k,2)-ctail(k,1))**2
2329 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2330 c! & +dhead(1,1,itypi,itypj))**2))
2331 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2332 c! & +dhead(2,1,itypi,itypj))**2))
2333 c------------------------------------------------------------------------
2334 c Polarization energy
2335 MomoFac2 = (1.0d0 - chi2 * sqom1)
2336 RR2 = R2 * R2 / MomoFac2
2337 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2338 fgb2 = sqrt(RR2 + a12sq * ee2)
2339 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2341 c!-------------------------------------------------------------------
2342 c! derivative of Epol is Gpol...
2343 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2345 dFGBdR2 = ( (R2 / MomoFac2)
2346 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2348 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2349 & * (2.0d0 - 0.5d0 * ee2) )
2351 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2353 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2356 c!-------------------------------------------------------------------
2357 c! Return the results
2358 c! (See comments in Eqq)
2360 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2362 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2363 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2364 facd2 = d2 * vbld_inv(j+nres)
2365 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2367 condor = (erhead_tail(k,2)
2368 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2370 gvdwx(k,i) = gvdwx(k,i)
2371 & - dPOLdR2 * (erhead_tail(k,2)
2372 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2373 gvdwx(k,j) = gvdwx(k,j)
2374 & + dPOLdR2 * condor
2376 gvdwc(k,i) = gvdwc(k,i)
2377 & - dPOLdR2 * erhead_tail(k,2)
2378 gvdwc(k,j) = gvdwc(k,j)
2379 & + dPOLdR2 * erhead_tail(k,2)
2386 c!-------------------------------------------------------------------
2389 SUBROUTINE eqd(Ecl,Elj,Epol)
2391 INCLUDE 'DIMENSIONS'
2392 INCLUDE 'DIMENSIONS.ZSCOPT'
2393 INCLUDE 'COMMON.CALC'
2394 INCLUDE 'COMMON.CHAIN'
2395 INCLUDE 'COMMON.CONTROL'
2396 INCLUDE 'COMMON.DERIV'
2397 INCLUDE 'COMMON.EMP'
2398 INCLUDE 'COMMON.GEO'
2399 INCLUDE 'COMMON.INTERACT'
2400 INCLUDE 'COMMON.IOUNITS'
2401 INCLUDE 'COMMON.LOCAL'
2402 INCLUDE 'COMMON.NAMES'
2403 INCLUDE 'COMMON.VAR'
2404 double precision scalar, facd4, federmaus
2405 alphapol1 = alphapol(itypi,itypj)
2406 w1 = wqdip(1,itypi,itypj)
2407 w2 = wqdip(2,itypi,itypj)
2408 pis = sig0head(itypi,itypj)
2409 eps_head = epshead(itypi,itypj)
2410 c!-------------------------------------------------------------------
2411 c! R1 - distance between head of ith side chain and tail of jth sidechain
2414 c! Calculate head-to-tail distances
2415 R1=R1+(ctail(k,2)-chead(k,1))**2
2420 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2421 c! & +dhead(1,1,itypi,itypj))**2))
2422 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2423 c! & +dhead(2,1,itypi,itypj))**2))
2425 c!-------------------------------------------------------------------
2427 sparrow = w1 * Qi * om1
2428 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2429 Ecl = sparrow / Rhead**2.0d0
2430 & - hawk / Rhead**4.0d0
2431 c!-------------------------------------------------------------------
2432 c! derivative of ecl is Gcl
2434 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2435 & + 4.0d0 * hawk / Rhead**5.0d0
2437 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2439 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2440 c--------------------------------------------------------------------
2441 c Polarization energy
2443 MomoFac1 = (1.0d0 - chi1 * sqom2)
2444 RR1 = R1 * R1 / MomoFac1
2445 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2446 fgb1 = sqrt( RR1 + a12sq * ee1)
2447 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2449 c!------------------------------------------------------------------
2450 c! derivative of Epol is Gpol...
2451 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2453 dFGBdR1 = ( (R1 / MomoFac1)
2454 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2455 & / ( 2.0d0 * fgb1 )
2456 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2457 & * (2.0d0 - 0.5d0 * ee1) )
2459 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2462 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2464 c!-------------------------------------------------------------------
2466 pom = (pis / Rhead)**6.0d0
2467 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2468 c! derivative of Elj is Glj
2469 dGLJdR = 4.0d0 * eps_head
2470 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2471 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2472 c!-------------------------------------------------------------------
2473 c! Return the results
2475 erhead(k) = Rhead_distance(k)/Rhead
2476 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2479 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2480 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2481 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2482 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2483 facd1 = d1 * vbld_inv(i+nres)
2484 facd2 = d2 * vbld_inv(j+nres)
2485 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2488 hawk = (erhead_tail(k,1) +
2489 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2491 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2492 gvdwx(k,i) = gvdwx(k,i)
2497 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2498 gvdwx(k,j) = gvdwx(k,j)
2500 & + dPOLdR1 * (erhead_tail(k,1)
2501 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2505 gvdwc(k,i) = gvdwc(k,i)
2506 & - dGCLdR * erhead(k)
2507 & - dPOLdR1 * erhead_tail(k,1)
2508 & - dGLJdR * erhead(k)
2510 gvdwc(k,j) = gvdwc(k,j)
2511 & + dGCLdR * erhead(k)
2512 & + dPOLdR1 * erhead_tail(k,1)
2513 & + dGLJdR * erhead(k)
2520 c!-------------------------------------------------------------------
2523 SUBROUTINE edq(Ecl,Elj,Epol)
2525 INCLUDE 'DIMENSIONS'
2526 INCLUDE 'DIMENSIONS.ZSCOPT'
2527 INCLUDE 'COMMON.CALC'
2528 INCLUDE 'COMMON.CHAIN'
2529 INCLUDE 'COMMON.CONTROL'
2530 INCLUDE 'COMMON.DERIV'
2531 INCLUDE 'COMMON.EMP'
2532 INCLUDE 'COMMON.GEO'
2533 INCLUDE 'COMMON.INTERACT'
2534 INCLUDE 'COMMON.IOUNITS'
2535 INCLUDE 'COMMON.LOCAL'
2536 INCLUDE 'COMMON.NAMES'
2537 INCLUDE 'COMMON.VAR'
2538 double precision scalar, facd3, adler
2539 alphapol2 = alphapol(itypj,itypi)
2540 w1 = wqdip(1,itypi,itypj)
2541 w2 = wqdip(2,itypi,itypj)
2542 pis = sig0head(itypi,itypj)
2543 eps_head = epshead(itypi,itypj)
2544 c!-------------------------------------------------------------------
2545 c! R2 - distance between head of jth side chain and tail of ith sidechain
2548 c! Calculate head-to-tail distances
2549 R2=R2+(chead(k,2)-ctail(k,1))**2
2554 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2555 c! & +dhead(1,1,itypi,itypj))**2))
2556 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2557 c! & +dhead(2,1,itypi,itypj))**2))
2560 c!-------------------------------------------------------------------
2562 sparrow = w1 * Qi * om1
2563 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2564 ECL = sparrow / Rhead**2.0d0
2565 & - hawk / Rhead**4.0d0
2566 c!-------------------------------------------------------------------
2567 c! derivative of ecl is Gcl
2569 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2570 & + 4.0d0 * hawk / Rhead**5.0d0
2572 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2574 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2575 c--------------------------------------------------------------------
2576 c Polarization energy
2578 MomoFac2 = (1.0d0 - chi2 * sqom1)
2579 RR2 = R2 * R2 / MomoFac2
2580 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2581 fgb2 = sqrt(RR2 + a12sq * ee2)
2582 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2584 c! derivative of Epol is Gpol...
2585 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2587 dFGBdR2 = ( (R2 / MomoFac2)
2588 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2590 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2591 & * (2.0d0 - 0.5d0 * ee2) )
2593 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2595 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2598 c!-------------------------------------------------------------------
2600 pom = (pis / Rhead)**6.0d0
2601 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2602 c! derivative of Elj is Glj
2603 dGLJdR = 4.0d0 * eps_head
2604 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2605 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2606 c!-------------------------------------------------------------------
2607 c! Return the results
2608 c! (see comments in Eqq)
2610 erhead(k) = Rhead_distance(k)/Rhead
2611 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2613 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2614 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2615 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2616 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2617 facd1 = d1 * vbld_inv(i+nres)
2618 facd2 = d2 * vbld_inv(j+nres)
2619 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2622 condor = (erhead_tail(k,2)
2623 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2625 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2626 gvdwx(k,i) = gvdwx(k,i)
2628 & - dPOLdR2 * (erhead_tail(k,2)
2629 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2632 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2633 gvdwx(k,j) = gvdwx(k,j)
2635 & + dPOLdR2 * condor
2639 gvdwc(k,i) = gvdwc(k,i)
2640 & - dGCLdR * erhead(k)
2641 & - dPOLdR2 * erhead_tail(k,2)
2642 & - dGLJdR * erhead(k)
2644 gvdwc(k,j) = gvdwc(k,j)
2645 & + dGCLdR * erhead(k)
2646 & + dPOLdR2 * erhead_tail(k,2)
2647 & + dGLJdR * erhead(k)
2654 C--------------------------------------------------------------------
2659 INCLUDE 'DIMENSIONS'
2660 INCLUDE 'DIMENSIONS.ZSCOPT'
2661 INCLUDE 'COMMON.CALC'
2662 INCLUDE 'COMMON.CHAIN'
2663 INCLUDE 'COMMON.CONTROL'
2664 INCLUDE 'COMMON.DERIV'
2665 INCLUDE 'COMMON.EMP'
2666 INCLUDE 'COMMON.GEO'
2667 INCLUDE 'COMMON.INTERACT'
2668 INCLUDE 'COMMON.IOUNITS'
2669 INCLUDE 'COMMON.LOCAL'
2670 INCLUDE 'COMMON.NAMES'
2671 INCLUDE 'COMMON.VAR'
2672 double precision scalar
2673 c! csig = sigiso(itypi,itypj)
2674 w1 = wqdip(1,itypi,itypj)
2675 w2 = wqdip(2,itypi,itypj)
2676 c!-------------------------------------------------------------------
2678 fac = (om12 - 3.0d0 * om1 * om2)
2679 c1 = (w1 / (Rhead**3.0d0)) * fac
2680 c2 = (w2 / Rhead ** 6.0d0)
2681 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2683 c! write (*,*) "w1 = ", w1
2684 c! write (*,*) "w2 = ", w2
2685 c! write (*,*) "om1 = ", om1
2686 c! write (*,*) "om2 = ", om2
2687 c! write (*,*) "om12 = ", om12
2688 c! write (*,*) "fac = ", fac
2689 c! write (*,*) "c1 = ", c1
2690 c! write (*,*) "c2 = ", c2
2691 c! write (*,*) "Ecl = ", Ecl
2692 c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
2693 c! write (*,*) "c2_2 = ",
2694 c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2695 c!-------------------------------------------------------------------
2696 c! dervative of ECL is GCL...
2698 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
2699 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
2700 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
2703 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
2704 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2705 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
2708 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
2709 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2710 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
2713 c1 = w1 / (Rhead ** 3.0d0)
2714 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
2716 c!-------------------------------------------------------------------
2717 c! Return the results
2718 c! (see comments in Eqq)
2720 erhead(k) = Rhead_distance(k)/Rhead
2722 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2723 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2724 facd1 = d1 * vbld_inv(i+nres)
2725 facd2 = d2 * vbld_inv(j+nres)
2728 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2729 gvdwx(k,i) = gvdwx(k,i)
2731 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2732 gvdwx(k,j) = gvdwx(k,j)
2735 gvdwc(k,i) = gvdwc(k,i)
2736 & - dGCLdR * erhead(k)
2737 gvdwc(k,j) = gvdwc(k,j)
2738 & + dGCLdR * erhead(k)
2744 c!-------------------------------------------------------------------
2747 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
2750 INCLUDE 'DIMENSIONS'
2751 INCLUDE 'DIMENSIONS.ZSCOPT'
2752 c! itypi, itypj, i, j, k, l, chead,
2753 INCLUDE 'COMMON.CALC'
2755 INCLUDE 'COMMON.CHAIN'
2757 INCLUDE 'COMMON.DERIV'
2758 c! electrostatic gradients-specific variables
2759 INCLUDE 'COMMON.EMP'
2760 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
2761 INCLUDE 'COMMON.INTERACT'
2763 c INCLUDE 'COMMON.MD'
2764 c! io for debug, disable it in final builds
2765 INCLUDE 'COMMON.IOUNITS'
2766 double precision Rb /1.987D-3/
2767 c!-------------------------------------------------------------------
2770 c! what amino acid is the aminoacid j'th?
2772 c! 1/(Gas Constant * Thermostate temperature) = BetaT
2773 c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
2775 c! BetaT = 1.0d0 / (t_bath * Rb)
2776 BetaT = 1.0d0 / (298.0d0 * Rb)
2778 sig0ij = sigma( itypi,itypj )
2779 chi1 = chi( itypi, itypj )
2780 chi2 = chi( itypj, itypi )
2782 chip1 = chipp( itypi, itypj )
2783 chip2 = chipp( itypj, itypi )
2784 chip12 = chip1 * chip2
2785 c! not used by momo potential, but needed by sc_angular which is shared
2786 c! by all energy_potential subroutines
2790 c! location, location, location
2791 xj = c( 1, nres+j ) - xi
2792 yj = c( 2, nres+j ) - yi
2793 zj = c( 3, nres+j ) - zi
2794 dxj = dc_norm( 1, nres+j )
2795 dyj = dc_norm( 2, nres+j )
2796 dzj = dc_norm( 3, nres+j )
2797 c! distance from center of chain(?) to polar/charged head
2798 c! write (*,*) "istate = ", 1
2799 c! write (*,*) "ii = ", 1
2800 c! write (*,*) "jj = ", 1
2801 d1 = dhead(1, 1, itypi, itypj)
2802 d2 = dhead(2, 1, itypi, itypj)
2804 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
2805 c! a12sq = a12sq * a12sq
2806 c! charge of amino acid itypi is...
2811 chis1 = chis(itypi,itypj)
2812 chis2 = chis(itypj,itypi)
2813 chis12 = chis1 * chis2
2814 sig1 = sigmap1(itypi,itypj)
2815 sig2 = sigmap2(itypi,itypj)
2816 c! write (*,*) "sig1 = ", sig1
2817 c! write (*,*) "sig2 = ", sig2
2818 c! alpha factors from Fcav/Gcav
2819 b1 = alphasur(1,itypi,itypj)
2820 b2 = alphasur(2,itypi,itypj)
2821 b3 = alphasur(3,itypi,itypj)
2822 b4 = alphasur(4,itypi,itypj)
2823 c! used to determine whether we want to do quadrupole calculations
2824 wqd = wquad(itypi, itypj)
2826 eps_in = epsintab(itypi,itypj)
2827 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
2828 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
2829 c!-------------------------------------------------------------------
2830 c! tail location and distance calculations
2833 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
2834 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
2836 c! tail distances will be themselves usefull elswhere
2837 c1 (in Gcav, for example)
2838 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
2839 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
2840 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
2842 & (Rtail_distance(1)*Rtail_distance(1))
2843 & + (Rtail_distance(2)*Rtail_distance(2))
2844 & + (Rtail_distance(3)*Rtail_distance(3)))
2845 c!-------------------------------------------------------------------
2846 c! Calculate location and distance between polar heads
2847 c! distance between heads
2848 c! for each one of our three dimensional space...
2850 c! location of polar head is computed by taking hydrophobic centre
2851 c! and moving by a d1 * dc_norm vector
2852 c! see unres publications for very informative images
2853 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
2854 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
2856 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
2857 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
2858 Rhead_distance(k) = chead(k,2) - chead(k,1)
2860 c! pitagoras (root of sum of squares)
2862 & (Rhead_distance(1)*Rhead_distance(1))
2863 & + (Rhead_distance(2)*Rhead_distance(2))
2864 & + (Rhead_distance(3)*Rhead_distance(3)))
2865 c!-------------------------------------------------------------------
2866 c! zero everything that should be zero'ed
2879 END SUBROUTINE elgrad_init
2882 C-----------------------------------------------------------------------------
2883 subroutine sc_angular
2884 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2885 C om12. Called by ebp, egb, and egbv.
2887 include 'COMMON.CALC'
2891 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2892 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2893 om12=dxi*dxj+dyi*dyj+dzi*dzj
2895 C Calculate eps1(om12) and its derivative in om12
2896 faceps1=1.0D0-om12*chiom12
2897 faceps1_inv=1.0D0/faceps1
2898 eps1=dsqrt(faceps1_inv)
2899 C Following variable is eps1*deps1/dom12
2900 eps1_om12=faceps1_inv*chiom12
2901 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2906 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2907 sigsq=1.0D0-facsig*faceps1_inv
2908 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2909 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2910 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2911 C Calculate eps2 and its derivatives in om1, om2, and om12.
2914 chipom12=chip12*om12
2915 facp=1.0D0-om12*chipom12
2917 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2918 C Following variable is the square root of eps2
2919 eps2rt=1.0D0-facp1*facp_inv
2920 C Following three variables are the derivatives of the square root of eps
2921 C in om1, om2, and om12.
2922 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2923 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2924 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2925 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2926 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2927 C Calculate whole angle-dependent part of epsilon and contributions
2928 C to its derivatives
2931 C----------------------------------------------------------------------------
2933 implicit real*8 (a-h,o-z)
2934 include 'DIMENSIONS'
2935 include 'DIMENSIONS.ZSCOPT'
2936 include 'COMMON.CHAIN'
2937 include 'COMMON.DERIV'
2938 include 'COMMON.CALC'
2939 double precision dcosom1(3),dcosom2(3)
2940 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2941 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2942 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2943 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2945 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2946 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2949 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2952 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2953 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2954 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2955 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2956 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2957 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2960 C Calculate the components of the gradient in DC and X
2964 gvdwc(l,k)=gvdwc(l,k)+gg(l)
2969 c------------------------------------------------------------------------------
2970 subroutine vec_and_deriv
2971 implicit real*8 (a-h,o-z)
2972 include 'DIMENSIONS'
2973 include 'DIMENSIONS.ZSCOPT'
2974 include 'COMMON.IOUNITS'
2975 include 'COMMON.GEO'
2976 include 'COMMON.VAR'
2977 include 'COMMON.LOCAL'
2978 include 'COMMON.CHAIN'
2979 include 'COMMON.VECTORS'
2980 include 'COMMON.DERIV'
2981 include 'COMMON.INTERACT'
2982 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2983 C Compute the local reference systems. For reference system (i), the
2984 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2985 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2987 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
2988 if (i.eq.nres-1) then
2989 C Case of the last full residue
2990 C Compute the Z-axis
2991 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2992 costh=dcos(pi-theta(nres))
2993 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2998 C Compute the derivatives of uz
3000 uzder(2,1,1)=-dc_norm(3,i-1)
3001 uzder(3,1,1)= dc_norm(2,i-1)
3002 uzder(1,2,1)= dc_norm(3,i-1)
3004 uzder(3,2,1)=-dc_norm(1,i-1)
3005 uzder(1,3,1)=-dc_norm(2,i-1)
3006 uzder(2,3,1)= dc_norm(1,i-1)
3009 uzder(2,1,2)= dc_norm(3,i)
3010 uzder(3,1,2)=-dc_norm(2,i)
3011 uzder(1,2,2)=-dc_norm(3,i)
3013 uzder(3,2,2)= dc_norm(1,i)
3014 uzder(1,3,2)= dc_norm(2,i)
3015 uzder(2,3,2)=-dc_norm(1,i)
3018 C Compute the Y-axis
3021 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
3024 C Compute the derivatives of uy
3027 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
3028 & -dc_norm(k,i)*dc_norm(j,i-1)
3029 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3031 uyder(j,j,1)=uyder(j,j,1)-costh
3032 uyder(j,j,2)=1.0d0+uyder(j,j,2)
3037 uygrad(l,k,j,i)=uyder(l,k,j)
3038 uzgrad(l,k,j,i)=uzder(l,k,j)
3042 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3043 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3044 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3045 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3049 C Compute the Z-axis
3050 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
3051 costh=dcos(pi-theta(i+2))
3052 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3057 C Compute the derivatives of uz
3059 uzder(2,1,1)=-dc_norm(3,i+1)
3060 uzder(3,1,1)= dc_norm(2,i+1)
3061 uzder(1,2,1)= dc_norm(3,i+1)
3063 uzder(3,2,1)=-dc_norm(1,i+1)
3064 uzder(1,3,1)=-dc_norm(2,i+1)
3065 uzder(2,3,1)= dc_norm(1,i+1)
3068 uzder(2,1,2)= dc_norm(3,i)
3069 uzder(3,1,2)=-dc_norm(2,i)
3070 uzder(1,2,2)=-dc_norm(3,i)
3072 uzder(3,2,2)= dc_norm(1,i)
3073 uzder(1,3,2)= dc_norm(2,i)
3074 uzder(2,3,2)=-dc_norm(1,i)
3077 C Compute the Y-axis
3080 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3083 C Compute the derivatives of uy
3086 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
3087 & -dc_norm(k,i)*dc_norm(j,i+1)
3088 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3090 uyder(j,j,1)=uyder(j,j,1)-costh
3091 uyder(j,j,2)=1.0d0+uyder(j,j,2)
3096 uygrad(l,k,j,i)=uyder(l,k,j)
3097 uzgrad(l,k,j,i)=uzder(l,k,j)
3101 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3102 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3103 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3104 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3110 vbld_inv_temp(1)=vbld_inv(i+1)
3111 if (i.lt.nres-1) then
3112 vbld_inv_temp(2)=vbld_inv(i+2)
3114 vbld_inv_temp(2)=vbld_inv(i)
3119 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
3120 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
3128 c------------------------------------------------------------------------------
3129 subroutine set_matrices
3130 implicit real*8 (a-h,o-z)
3131 include 'DIMENSIONS'
3135 integer status(MPI_STATUS_SIZE)
3137 include 'DIMENSIONS.ZSCOPT'
3138 include 'COMMON.IOUNITS'
3139 include 'COMMON.GEO'
3140 include 'COMMON.VAR'
3141 include 'COMMON.LOCAL'
3142 include 'COMMON.CHAIN'
3143 include 'COMMON.DERIV'
3144 include 'COMMON.INTERACT'
3145 include 'COMMON.CONTACTS'
3146 include 'COMMON.TORSION'
3147 include 'COMMON.VECTORS'
3148 include 'COMMON.FFIELD'
3149 double precision auxvec(2),auxmat(2,2)
3151 C Compute the virtual-bond-torsional-angle dependent quantities needed
3152 C to calculate the el-loc multibody terms of various order.
3154 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
3156 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3157 iti = itype2loc(itype(i-2))
3161 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3162 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3163 iti1 = itype2loc(itype(i-1))
3168 cost1=dcos(theta(i-1))
3169 sint1=dsin(theta(i-1))
3171 sint1cub=sint1sq*sint1
3172 sint1cost1=2*sint1*cost1
3174 write (iout,*) "bnew1",i,iti
3175 write (iout,*) (bnew1(k,1,iti),k=1,3)
3176 write (iout,*) (bnew1(k,2,iti),k=1,3)
3177 write (iout,*) "bnew2",i,iti
3178 write (iout,*) (bnew2(k,1,iti),k=1,3)
3179 write (iout,*) (bnew2(k,2,iti),k=1,3)
3182 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
3184 gtb1(k,i-2)=cost1*b1k-sint1sq*
3185 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
3186 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
3188 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
3189 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
3192 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
3193 cc(1,k,i-2)=sint1sq*aux
3194 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
3195 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
3196 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
3197 dd(1,k,i-2)=sint1sq*aux
3198 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
3199 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
3201 cc(2,1,i-2)=cc(1,2,i-2)
3202 cc(2,2,i-2)=-cc(1,1,i-2)
3203 gtcc(2,1,i-2)=gtcc(1,2,i-2)
3204 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
3205 dd(2,1,i-2)=dd(1,2,i-2)
3206 dd(2,2,i-2)=-dd(1,1,i-2)
3207 gtdd(2,1,i-2)=gtdd(1,2,i-2)
3208 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
3211 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
3212 EE(l,k,i-2)=sint1sq*aux
3214 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
3217 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
3218 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
3219 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
3220 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
3222 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
3223 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
3224 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
3226 c b1tilde(1,i-2)=b1(1,i-2)
3227 c b1tilde(2,i-2)=-b1(2,i-2)
3228 c b2tilde(1,i-2)=b2(1,i-2)
3229 c b2tilde(2,i-2)=-b2(2,i-2)
3231 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
3232 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
3233 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
3234 write (iout,*) 'theta=', theta(i-1)
3237 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3238 iti = itype2loc(itype(i-2))
3242 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3243 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3244 iti1 = itype2loc(itype(i-1))
3254 CC(k,l,i-2)=ccold(k,l,iti)
3255 DD(k,l,i-2)=ddold(k,l,iti)
3256 EE(k,l,i-2)=eeold(k,l,iti)
3260 b1tilde(1,i-2)= b1(1,i-2)
3261 b1tilde(2,i-2)=-b1(2,i-2)
3262 b2tilde(1,i-2)= b2(1,i-2)
3263 b2tilde(2,i-2)=-b2(2,i-2)
3265 Ctilde(1,1,i-2)= CC(1,1,i-2)
3266 Ctilde(1,2,i-2)= CC(1,2,i-2)
3267 Ctilde(2,1,i-2)=-CC(2,1,i-2)
3268 Ctilde(2,2,i-2)=-CC(2,2,i-2)
3270 Dtilde(1,1,i-2)= DD(1,1,i-2)
3271 Dtilde(1,2,i-2)= DD(1,2,i-2)
3272 Dtilde(2,1,i-2)=-DD(2,1,i-2)
3273 Dtilde(2,2,i-2)=-DD(2,2,i-2)
3274 c write(iout,*) "i",i," iti",iti
3275 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
3276 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
3279 if (i .lt. nres+1) then
3316 if (i .gt. 3 .and. i .lt. nres+1) then
3317 obrot_der(1,i-2)=-sin1
3318 obrot_der(2,i-2)= cos1
3319 Ugder(1,1,i-2)= sin1
3320 Ugder(1,2,i-2)=-cos1
3321 Ugder(2,1,i-2)=-cos1
3322 Ugder(2,2,i-2)=-sin1
3325 obrot2_der(1,i-2)=-dwasin2
3326 obrot2_der(2,i-2)= dwacos2
3327 Ug2der(1,1,i-2)= dwasin2
3328 Ug2der(1,2,i-2)=-dwacos2
3329 Ug2der(2,1,i-2)=-dwacos2
3330 Ug2der(2,2,i-2)=-dwasin2
3332 obrot_der(1,i-2)=0.0d0
3333 obrot_der(2,i-2)=0.0d0
3334 Ugder(1,1,i-2)=0.0d0
3335 Ugder(1,2,i-2)=0.0d0
3336 Ugder(2,1,i-2)=0.0d0
3337 Ugder(2,2,i-2)=0.0d0
3338 obrot2_der(1,i-2)=0.0d0
3339 obrot2_der(2,i-2)=0.0d0
3340 Ug2der(1,1,i-2)=0.0d0
3341 Ug2der(1,2,i-2)=0.0d0
3342 Ug2der(2,1,i-2)=0.0d0
3343 Ug2der(2,2,i-2)=0.0d0
3345 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3346 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3347 iti = itype2loc(itype(i-2))
3351 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3352 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3353 iti1 = itype2loc(itype(i-1))
3357 cd write (iout,*) '*******i',i,' iti1',iti
3358 cd write (iout,*) 'b1',b1(:,iti)
3359 cd write (iout,*) 'b2',b2(:,iti)
3360 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3361 c if (i .gt. iatel_s+2) then
3362 if (i .gt. nnt+2) then
3363 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
3365 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
3366 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
3368 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
3369 c & EE(1,2,iti),EE(2,2,i)
3370 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
3371 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
3372 c write(iout,*) "Macierz EUG",
3373 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
3375 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3377 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
3378 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
3379 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3380 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
3381 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
3392 DtUg2(l,k,i-2)=0.0d0
3396 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3397 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3399 muder(k,i-2)=Ub2der(k,i-2)
3401 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3402 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3403 if (itype(i-1).le.ntyp) then
3404 iti1 = itype2loc(itype(i-1))
3412 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3415 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
3416 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
3417 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
3418 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
3419 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
3420 & ((ee(l,k,i-2),l=1,2),k=1,2)
3422 cd write (iout,*) 'mu1',mu1(:,i-2)
3423 cd write (iout,*) 'mu2',mu2(:,i-2)
3424 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3427 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3428 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
3429 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3430 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
3431 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3433 C Vectors and matrices dependent on a single virtual-bond dihedral.
3434 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
3435 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3436 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
3437 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
3438 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
3440 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3441 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
3442 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
3443 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
3447 C Matrices dependent on two consecutive virtual-bond dihedrals.
3448 C The order of matrices is from left to right.
3449 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3452 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3454 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3455 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3457 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3458 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3460 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3461 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3462 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3468 C--------------------------------------------------------------------------
3469 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3471 C This subroutine calculates the average interaction energy and its gradient
3472 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3473 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3474 C The potential depends both on the distance of peptide-group centers and on
3475 C the orientation of the CA-CA virtual bonds.
3477 implicit real*8 (a-h,o-z)
3481 include 'DIMENSIONS'
3482 include 'DIMENSIONS.ZSCOPT'
3483 include 'COMMON.CONTROL'
3484 include 'COMMON.IOUNITS'
3485 include 'COMMON.GEO'
3486 include 'COMMON.VAR'
3487 include 'COMMON.LOCAL'
3488 include 'COMMON.CHAIN'
3489 include 'COMMON.DERIV'
3490 include 'COMMON.INTERACT'
3491 include 'COMMON.CONTACTS'
3492 include 'COMMON.TORSION'
3493 include 'COMMON.VECTORS'
3494 include 'COMMON.FFIELD'
3495 include 'COMMON.TIME1'
3496 include 'COMMON.SPLITELE'
3497 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3498 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3499 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3500 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3501 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3502 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3504 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3506 double precision scal_el /1.0d0/
3508 double precision scal_el /0.5d0/
3511 C 13-go grudnia roku pamietnego...
3512 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3513 & 0.0d0,1.0d0,0.0d0,
3514 & 0.0d0,0.0d0,1.0d0/
3515 cd write(iout,*) 'In EELEC'
3517 cd write(iout,*) 'Type',i
3518 cd write(iout,*) 'B1',B1(:,i)
3519 cd write(iout,*) 'B2',B2(:,i)
3520 cd write(iout,*) 'CC',CC(:,:,i)
3521 cd write(iout,*) 'DD',DD(:,:,i)
3522 cd write(iout,*) 'EE',EE(:,:,i)
3524 cd call check_vecgrad
3526 if (icheckgrad.eq.1) then
3528 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3530 dc_norm(k,i)=dc(k,i)*fac
3532 c write (iout,*) 'i',i,' fac',fac
3535 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3536 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3537 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3538 c call vec_and_deriv
3544 time_mat=time_mat+MPI_Wtime()-time01
3548 cd write (iout,*) 'i=',i
3550 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3553 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3554 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3567 cd print '(a)','Enter EELEC'
3568 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3570 gel_loc_loc(i)=0.0d0
3575 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3577 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3579 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3580 do i=iturn3_start,iturn3_end
3582 C write(iout,*) "tu jest i",i
3583 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3584 C changes suggested by Ana to avoid out of bounds
3585 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
3586 c & .or.((i+4).gt.nres)
3587 c & .or.((i-1).le.0)
3588 C end of changes by Ana
3589 C dobra zmiana wycofana
3590 & .or. itype(i+2).eq.ntyp1
3591 & .or. itype(i+3).eq.ntyp1) cycle
3592 C Adam: Instructions below will switch off existing interactions
3594 c if(itype(i-1).eq.ntyp1)cycle
3596 c if(i.LT.nres-3)then
3597 c if (itype(i+4).eq.ntyp1) cycle
3602 dx_normi=dc_norm(1,i)
3603 dy_normi=dc_norm(2,i)
3604 dz_normi=dc_norm(3,i)
3605 xmedi=c(1,i)+0.5d0*dxi
3606 ymedi=c(2,i)+0.5d0*dyi
3607 zmedi=c(3,i)+0.5d0*dzi
3608 xmedi=mod(xmedi,boxxsize)
3609 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3610 ymedi=mod(ymedi,boxysize)
3611 if (ymedi.lt.0) ymedi=ymedi+boxysize
3612 zmedi=mod(zmedi,boxzsize)
3613 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3615 call eelecij(i,i+2,ees,evdw1,eel_loc)
3616 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3617 num_cont_hb(i)=num_conti
3619 do i=iturn4_start,iturn4_end
3621 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3622 C changes suggested by Ana to avoid out of bounds
3623 c & .or.((i+5).gt.nres)
3624 c & .or.((i-1).le.0)
3625 C end of changes suggested by Ana
3626 & .or. itype(i+3).eq.ntyp1
3627 & .or. itype(i+4).eq.ntyp1
3628 c & .or. itype(i+5).eq.ntyp1
3629 c & .or. itype(i).eq.ntyp1
3630 c & .or. itype(i-1).eq.ntyp1
3635 dx_normi=dc_norm(1,i)
3636 dy_normi=dc_norm(2,i)
3637 dz_normi=dc_norm(3,i)
3638 xmedi=c(1,i)+0.5d0*dxi
3639 ymedi=c(2,i)+0.5d0*dyi
3640 zmedi=c(3,i)+0.5d0*dzi
3641 C Return atom into box, boxxsize is size of box in x dimension
3643 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3644 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3645 C Condition for being inside the proper box
3646 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3647 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3651 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3652 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3653 C Condition for being inside the proper box
3654 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3655 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3659 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3660 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3661 C Condition for being inside the proper box
3662 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3663 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3666 xmedi=mod(xmedi,boxxsize)
3667 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3668 ymedi=mod(ymedi,boxysize)
3669 if (ymedi.lt.0) ymedi=ymedi+boxysize
3670 zmedi=mod(zmedi,boxzsize)
3671 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3673 num_conti=num_cont_hb(i)
3674 c write(iout,*) "JESTEM W PETLI"
3675 call eelecij(i,i+3,ees,evdw1,eel_loc)
3676 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3677 & call eturn4(i,eello_turn4)
3678 num_cont_hb(i)=num_conti
3680 C Loop over all neighbouring boxes
3685 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3688 do i=iatel_s,iatel_e
3691 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3692 C changes suggested by Ana to avoid out of bounds
3693 c & .or.((i+2).gt.nres)
3694 c & .or.((i-1).le.0)
3695 C end of changes by Ana
3696 c & .or. itype(i+2).eq.ntyp1
3697 c & .or. itype(i-1).eq.ntyp1
3702 dx_normi=dc_norm(1,i)
3703 dy_normi=dc_norm(2,i)
3704 dz_normi=dc_norm(3,i)
3705 xmedi=c(1,i)+0.5d0*dxi
3706 ymedi=c(2,i)+0.5d0*dyi
3707 zmedi=c(3,i)+0.5d0*dzi
3708 xmedi=mod(xmedi,boxxsize)
3709 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3710 ymedi=mod(ymedi,boxysize)
3711 if (ymedi.lt.0) ymedi=ymedi+boxysize
3712 zmedi=mod(zmedi,boxzsize)
3713 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3714 C xmedi=xmedi+xshift*boxxsize
3715 C ymedi=ymedi+yshift*boxysize
3716 C zmedi=zmedi+zshift*boxzsize
3718 C Return tom into box, boxxsize is size of box in x dimension
3720 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3721 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3722 C Condition for being inside the proper box
3723 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3724 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3728 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3729 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3730 C Condition for being inside the proper box
3731 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3732 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3736 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3737 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3738 cC Condition for being inside the proper box
3739 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3740 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3744 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3745 num_conti=num_cont_hb(i)
3747 do j=ielstart(i),ielend(i)
3749 C write (iout,*) i,j
3751 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3752 C changes suggested by Ana to avoid out of bounds
3753 c & .or.((j+2).gt.nres)
3754 c & .or.((j-1).le.0)
3755 C end of changes by Ana
3756 c & .or.itype(j+2).eq.ntyp1
3757 c & .or.itype(j-1).eq.ntyp1
3759 call eelecij(i,j,ees,evdw1,eel_loc)
3761 num_cont_hb(i)=num_conti
3767 c write (iout,*) "Number of loop steps in EELEC:",ind
3769 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3770 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3772 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3773 ccc eel_loc=eel_loc+eello_turn3
3774 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3777 C-------------------------------------------------------------------------------
3778 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3779 implicit real*8 (a-h,o-z)
3780 include 'DIMENSIONS'
3781 include 'DIMENSIONS.ZSCOPT'
3785 include 'COMMON.CONTROL'
3786 include 'COMMON.IOUNITS'
3787 include 'COMMON.GEO'
3788 include 'COMMON.VAR'
3789 include 'COMMON.LOCAL'
3790 include 'COMMON.CHAIN'
3791 include 'COMMON.DERIV'
3792 include 'COMMON.INTERACT'
3793 include 'COMMON.CONTACTS'
3794 include 'COMMON.TORSION'
3795 include 'COMMON.VECTORS'
3796 include 'COMMON.FFIELD'
3797 include 'COMMON.TIME1'
3798 include 'COMMON.SPLITELE'
3799 include 'COMMON.SHIELD'
3800 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3801 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3802 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3803 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3804 & gmuij2(4),gmuji2(4)
3805 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3806 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3808 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3810 double precision scal_el /1.0d0/
3812 double precision scal_el /0.5d0/
3815 C 13-go grudnia roku pamietnego...
3816 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3817 & 0.0d0,1.0d0,0.0d0,
3818 & 0.0d0,0.0d0,1.0d0/
3819 integer xshift,yshift,zshift
3820 c time00=MPI_Wtime()
3821 cd write (iout,*) "eelecij",i,j
3825 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3826 aaa=app(iteli,itelj)
3827 bbb=bpp(iteli,itelj)
3828 ael6i=ael6(iteli,itelj)
3829 ael3i=ael3(iteli,itelj)
3833 dx_normj=dc_norm(1,j)
3834 dy_normj=dc_norm(2,j)
3835 dz_normj=dc_norm(3,j)
3836 C xj=c(1,j)+0.5D0*dxj-xmedi
3837 C yj=c(2,j)+0.5D0*dyj-ymedi
3838 C zj=c(3,j)+0.5D0*dzj-zmedi
3843 if (xj.lt.0) xj=xj+boxxsize
3845 if (yj.lt.0) yj=yj+boxysize
3847 if (zj.lt.0) zj=zj+boxzsize
3848 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3849 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3857 xj=xj_safe+xshift*boxxsize
3858 yj=yj_safe+yshift*boxysize
3859 zj=zj_safe+zshift*boxzsize
3860 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3861 if(dist_temp.lt.dist_init) then
3871 if (isubchap.eq.1) then
3880 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3882 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3883 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3884 C Condition for being inside the proper box
3885 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3886 c & (xj.lt.((-0.5d0)*boxxsize))) then
3890 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3891 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3892 C Condition for being inside the proper box
3893 c if ((yj.gt.((0.5d0)*boxysize)).or.
3894 c & (yj.lt.((-0.5d0)*boxysize))) then
3898 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3899 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3900 C Condition for being inside the proper box
3901 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3902 c & (zj.lt.((-0.5d0)*boxzsize))) then
3905 C endif !endPBC condintion
3909 rij=xj*xj+yj*yj+zj*zj
3911 sss=sscale(sqrt(rij))
3912 sssgrad=sscagrad(sqrt(rij))
3913 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
3914 c & " rlamb",rlamb," sss",sss
3915 c if (sss.gt.0.0d0) then
3921 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3922 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3923 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3924 fac=cosa-3.0D0*cosb*cosg
3926 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3927 if (j.eq.i+2) ev1=scal_el*ev1
3932 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3936 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3937 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3938 if (shield_mode.gt.0) then
3941 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3942 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3951 evdw1=evdw1+evdwij*sss
3952 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3953 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3954 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3955 cd & xmedi,ymedi,zmedi,xj,yj,zj
3957 if (energy_dec) then
3958 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
3960 &,iteli,itelj,aaa,evdw1,sss
3961 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
3962 &fac_shield(i),fac_shield(j)
3966 C Calculate contributions to the Cartesian gradient.
3969 facvdw=-6*rrmij*(ev1+evdwij)*sss
3970 facel=-3*rrmij*(el1+eesij)
3977 * Radial derivatives. First process both termini of the fragment (i,j)
3983 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3984 & (shield_mode.gt.0)) then
3986 do ilist=1,ishield_list(i)
3987 iresshield=shield_list(ilist,i)
3989 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
3991 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
3993 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
3994 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3995 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
3996 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
3997 C if (iresshield.gt.i) then
3998 C do ishi=i+1,iresshield-1
3999 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4000 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4004 C do ishi=iresshield,i
4005 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4006 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4012 do ilist=1,ishield_list(j)
4013 iresshield=shield_list(ilist,j)
4015 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
4017 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4019 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
4020 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4022 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4023 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4024 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4025 C if (iresshield.gt.j) then
4026 C do ishi=j+1,iresshield-1
4027 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4028 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4032 C do ishi=iresshield,j
4033 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4034 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4041 gshieldc(k,i)=gshieldc(k,i)+
4042 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4043 gshieldc(k,j)=gshieldc(k,j)+
4044 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4045 gshieldc(k,i-1)=gshieldc(k,i-1)+
4046 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4047 gshieldc(k,j-1)=gshieldc(k,j-1)+
4048 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4053 c ghalf=0.5D0*ggg(k)
4054 c gelc(k,i)=gelc(k,i)+ghalf
4055 c gelc(k,j)=gelc(k,j)+ghalf
4057 c 9/28/08 AL Gradient compotents will be summed only at the end
4058 C print *,"before", gelc_long(1,i), gelc_long(1,j)
4060 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4061 C & +grad_shield(k,j)*eesij/fac_shield(j)
4062 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4063 C & +grad_shield(k,i)*eesij/fac_shield(i)
4064 C gelc_long(k,i-1)=gelc_long(k,i-1)
4065 C & +grad_shield(k,i)*eesij/fac_shield(i)
4066 C gelc_long(k,j-1)=gelc_long(k,j-1)
4067 C & +grad_shield(k,j)*eesij/fac_shield(j)
4069 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
4072 * Loop over residues i+1 thru j-1.
4076 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4079 if (sss.gt.0.0) then
4080 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4081 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4082 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4089 c ghalf=0.5D0*ggg(k)
4090 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
4091 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
4093 c 9/28/08 AL Gradient compotents will be summed only at the end
4095 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4096 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4099 * Loop over residues i+1 thru j-1.
4103 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
4109 facvdw=(ev1+evdwij)*sss
4112 fac=-3*rrmij*(facvdw+facvdw+facel)
4117 * Radial derivatives. First process both termini of the fragment (i,j)
4121 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
4123 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
4125 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
4127 c ghalf=0.5D0*ggg(k)
4128 c gelc(k,i)=gelc(k,i)+ghalf
4129 c gelc(k,j)=gelc(k,j)+ghalf
4131 c 9/28/08 AL Gradient compotents will be summed only at the end
4133 gelc_long(k,j)=gelc(k,j)+ggg(k)
4134 gelc_long(k,i)=gelc(k,i)-ggg(k)
4137 * Loop over residues i+1 thru j-1.
4141 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4144 c 9/28/08 AL Gradient compotents will be summed only at the end
4145 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4146 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4147 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4149 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4150 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4158 ecosa=2.0D0*fac3*fac1+fac4
4161 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4162 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4164 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4165 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4167 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4168 cd & (dcosg(k),k=1,3)
4170 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4171 & fac_shield(i)**2*fac_shield(j)**2
4174 c ghalf=0.5D0*ggg(k)
4175 c gelc(k,i)=gelc(k,i)+ghalf
4176 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4177 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4178 c gelc(k,j)=gelc(k,j)+ghalf
4179 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4180 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4184 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4187 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4190 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4191 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4192 & *fac_shield(i)**2*fac_shield(j)**2
4194 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4195 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4196 & *fac_shield(i)**2*fac_shield(j)**2
4197 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4198 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4200 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4205 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4206 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4207 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4209 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4210 C energy of a peptide unit is assumed in the form of a second-order
4211 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4212 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4213 C are computed for EVERY pair of non-contiguous peptide groups.
4216 if (j.lt.nres-1) then
4228 muij(kkk)=mu(k,i)*mu(l,j)
4229 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4232 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4233 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4234 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4235 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4236 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4237 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4243 write (iout,*) 'EELEC: i',i,' j',j
4244 write (iout,*) 'j',j,' j1',j1,' j2',j2
4245 write(iout,*) 'muij',muij
4246 write (iout,*) "uy",uy(:,i)
4247 write (iout,*) "uz",uz(:,j)
4248 write (iout,*) "erij",erij
4250 ury=scalar(uy(1,i),erij)
4251 urz=scalar(uz(1,i),erij)
4252 vry=scalar(uy(1,j),erij)
4253 vrz=scalar(uz(1,j),erij)
4254 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4255 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4256 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4257 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4258 fac=dsqrt(-ael6i)*r3ij
4263 cd write (iout,'(4i5,4f10.5)')
4264 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4265 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4266 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4267 cd & uy(:,j),uz(:,j)
4268 cd write (iout,'(4f10.5)')
4269 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4270 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4271 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4272 cd write (iout,'(9f10.5/)')
4273 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4274 C Derivatives of the elements of A in virtual-bond vectors
4276 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4278 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4279 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4280 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4281 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4282 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4283 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4284 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4285 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4286 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4287 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4288 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4289 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4291 C Compute radial contributions to the gradient
4309 C Add the contributions coming from er
4312 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4313 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4314 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4315 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4318 C Derivatives in DC(i)
4319 cgrad ghalf1=0.5d0*agg(k,1)
4320 cgrad ghalf2=0.5d0*agg(k,2)
4321 cgrad ghalf3=0.5d0*agg(k,3)
4322 cgrad ghalf4=0.5d0*agg(k,4)
4323 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4324 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4325 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4326 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4327 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4328 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4329 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4330 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4331 C Derivatives in DC(i+1)
4332 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4333 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4334 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4335 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4336 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4337 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4338 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4339 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4340 C Derivatives in DC(j)
4341 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4342 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4343 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4344 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4345 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4346 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4347 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4348 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4349 C Derivatives in DC(j+1) or DC(nres-1)
4350 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4351 & -3.0d0*vryg(k,3)*ury)
4352 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4353 & -3.0d0*vrzg(k,3)*ury)
4354 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4355 & -3.0d0*vryg(k,3)*urz)
4356 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4357 & -3.0d0*vrzg(k,3)*urz)
4358 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4360 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4375 aggi(k,l)=-aggi(k,l)
4376 aggi1(k,l)=-aggi1(k,l)
4377 aggj(k,l)=-aggj(k,l)
4378 aggj1(k,l)=-aggj1(k,l)
4382 if (j.lt.nres-1) then
4388 aggi(k,l)=-aggi(k,l)
4389 aggi1(k,l)=-aggi1(k,l)
4390 aggj(k,l)=-aggj(k,l)
4391 aggj1(k,l)=-aggj1(k,l)
4402 aggi(k,l)=-aggi(k,l)
4403 aggi1(k,l)=-aggi1(k,l)
4404 aggj(k,l)=-aggj(k,l)
4405 aggj1(k,l)=-aggj1(k,l)
4410 IF (wel_loc.gt.0.0d0) THEN
4411 C Contribution to the local-electrostatic energy coming from the i-j pair
4412 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4415 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
4417 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
4418 & " wel_loc",wel_loc
4420 if (shield_mode.eq.0) then
4427 eel_loc_ij=eel_loc_ij
4428 & *fac_shield(i)*fac_shield(j)
4429 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4430 & 'eelloc',i,j,eel_loc_ij
4431 c if (eel_loc_ij.ne.0)
4432 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4433 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4435 eel_loc=eel_loc+eel_loc_ij
4436 C Now derivative over eel_loc
4438 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4439 & (shield_mode.gt.0)) then
4442 do ilist=1,ishield_list(i)
4443 iresshield=shield_list(ilist,i)
4445 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4448 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4450 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4451 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4455 do ilist=1,ishield_list(j)
4456 iresshield=shield_list(ilist,j)
4458 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4461 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4463 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4464 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4471 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4472 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4473 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4474 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4475 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4476 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4477 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4478 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4483 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4484 c & ' eel_loc_ij',eel_loc_ij
4485 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4486 C Calculate patrial derivative for theta angle
4488 geel_loc_ij=(a22*gmuij1(1)
4492 & *fac_shield(i)*fac_shield(j)
4493 c write(iout,*) "derivative over thatai"
4494 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4496 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4497 & geel_loc_ij*wel_loc
4498 c write(iout,*) "derivative over thatai-1"
4499 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4506 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4507 & geel_loc_ij*wel_loc
4508 & *fac_shield(i)*fac_shield(j)
4510 c Derivative over j residue
4511 geel_loc_ji=a22*gmuji1(1)
4515 c write(iout,*) "derivative over thataj"
4516 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4519 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4520 & geel_loc_ji*wel_loc
4521 & *fac_shield(i)*fac_shield(j)
4528 c write(iout,*) "derivative over thataj-1"
4529 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4531 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4532 & geel_loc_ji*wel_loc
4533 & *fac_shield(i)*fac_shield(j)
4535 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4537 C Partial derivatives in virtual-bond dihedral angles gamma
4539 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4540 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4541 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4542 & *fac_shield(i)*fac_shield(j)
4544 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4545 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4546 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4547 & *fac_shield(i)*fac_shield(j)
4548 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4550 ggg(l)=(agg(l,1)*muij(1)+
4551 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4552 & *fac_shield(i)*fac_shield(j)
4553 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4554 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4555 cgrad ghalf=0.5d0*ggg(l)
4556 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4557 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4561 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4564 C Remaining derivatives of eello
4566 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4567 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4568 & *fac_shield(i)*fac_shield(j)
4570 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4571 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4572 & *fac_shield(i)*fac_shield(j)
4574 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4575 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4576 & *fac_shield(i)*fac_shield(j)
4578 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4579 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4580 & *fac_shield(i)*fac_shield(j)
4587 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4588 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4589 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4590 & .and. num_conti.le.maxconts) then
4591 c write (iout,*) i,j," entered corr"
4593 C Calculate the contact function. The ith column of the array JCONT will
4594 C contain the numbers of atoms that make contacts with the atom I (of numbers
4595 C greater than I). The arrays FACONT and GACONT will contain the values of
4596 C the contact function and its derivative.
4597 c r0ij=1.02D0*rpp(iteli,itelj)
4598 c r0ij=1.11D0*rpp(iteli,itelj)
4599 r0ij=2.20D0*rpp(iteli,itelj)
4600 c r0ij=1.55D0*rpp(iteli,itelj)
4601 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4602 if (fcont.gt.0.0D0) then
4603 num_conti=num_conti+1
4604 if (num_conti.gt.maxconts) then
4605 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4606 & ' will skip next contacts for this conf.'
4608 jcont_hb(num_conti,i)=j
4609 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4610 cd & " jcont_hb",jcont_hb(num_conti,i)
4611 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4612 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4613 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4615 d_cont(num_conti,i)=rij
4616 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4617 C --- Electrostatic-interaction matrix ---
4618 a_chuj(1,1,num_conti,i)=a22
4619 a_chuj(1,2,num_conti,i)=a23
4620 a_chuj(2,1,num_conti,i)=a32
4621 a_chuj(2,2,num_conti,i)=a33
4622 C --- Gradient of rij
4625 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4632 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4633 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4634 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4635 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4636 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4642 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4643 C Calculate contact energies
4645 wij=cosa-3.0D0*cosb*cosg
4648 c fac3=dsqrt(-ael6i)/r0ij**3
4649 fac3=dsqrt(-ael6i)*r3ij
4650 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4651 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4652 if (ees0tmp.gt.0) then
4653 ees0pij=dsqrt(ees0tmp)
4657 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4658 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4659 if (ees0tmp.gt.0) then
4660 ees0mij=dsqrt(ees0tmp)
4665 if (shield_mode.eq.0) then
4669 ees0plist(num_conti,i)=j
4670 C fac_shield(i)=0.4d0
4671 C fac_shield(j)=0.6d0
4673 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4674 & *fac_shield(i)*fac_shield(j)
4675 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4676 & *fac_shield(i)*fac_shield(j)
4677 C Diagnostics. Comment out or remove after debugging!
4678 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4679 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4680 c ees0m(num_conti,i)=0.0D0
4682 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4683 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4684 C Angular derivatives of the contact function
4686 ees0pij1=fac3/ees0pij
4687 ees0mij1=fac3/ees0mij
4688 fac3p=-3.0D0*fac3*rrmij
4689 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4690 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4692 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4693 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4694 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4695 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4696 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4697 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4698 ecosap=ecosa1+ecosa2
4699 ecosbp=ecosb1+ecosb2
4700 ecosgp=ecosg1+ecosg2
4701 ecosam=ecosa1-ecosa2
4702 ecosbm=ecosb1-ecosb2
4703 ecosgm=ecosg1-ecosg2
4712 facont_hb(num_conti,i)=fcont
4715 fprimcont=fprimcont/rij
4716 cd facont_hb(num_conti,i)=1.0D0
4717 C Following line is for diagnostics.
4720 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4721 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4724 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4725 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4727 gggp(1)=gggp(1)+ees0pijp*xj
4728 gggp(2)=gggp(2)+ees0pijp*yj
4729 gggp(3)=gggp(3)+ees0pijp*zj
4730 gggm(1)=gggm(1)+ees0mijp*xj
4731 gggm(2)=gggm(2)+ees0mijp*yj
4732 gggm(3)=gggm(3)+ees0mijp*zj
4733 C Derivatives due to the contact function
4734 gacont_hbr(1,num_conti,i)=fprimcont*xj
4735 gacont_hbr(2,num_conti,i)=fprimcont*yj
4736 gacont_hbr(3,num_conti,i)=fprimcont*zj
4739 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4740 c following the change of gradient-summation algorithm.
4742 cgrad ghalfp=0.5D0*gggp(k)
4743 cgrad ghalfm=0.5D0*gggm(k)
4744 gacontp_hb1(k,num_conti,i)=!ghalfp
4745 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4746 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4747 & *fac_shield(i)*fac_shield(j)
4749 gacontp_hb2(k,num_conti,i)=!ghalfp
4750 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4751 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4752 & *fac_shield(i)*fac_shield(j)
4754 gacontp_hb3(k,num_conti,i)=gggp(k)
4755 & *fac_shield(i)*fac_shield(j)
4757 gacontm_hb1(k,num_conti,i)=!ghalfm
4758 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4759 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4760 & *fac_shield(i)*fac_shield(j)
4762 gacontm_hb2(k,num_conti,i)=!ghalfm
4763 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4764 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4765 & *fac_shield(i)*fac_shield(j)
4767 gacontm_hb3(k,num_conti,i)=gggm(k)
4768 & *fac_shield(i)*fac_shield(j)
4771 C Diagnostics. Comment out or remove after debugging!
4773 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4774 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4775 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4776 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4777 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4778 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4784 endif ! num_conti.le.maxconts
4788 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4791 ghalf=0.5d0*agg(l,k)
4792 aggi(l,k)=aggi(l,k)+ghalf
4793 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4794 aggj(l,k)=aggj(l,k)+ghalf
4797 if (j.eq.nres-1 .and. i.lt.j-2) then
4800 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4806 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4809 C-----------------------------------------------------------------------------
4810 subroutine eturn3(i,eello_turn3)
4811 C Third- and fourth-order contributions from turns
4812 implicit real*8 (a-h,o-z)
4813 include 'DIMENSIONS'
4814 include 'DIMENSIONS.ZSCOPT'
4815 include 'COMMON.IOUNITS'
4816 include 'COMMON.GEO'
4817 include 'COMMON.VAR'
4818 include 'COMMON.LOCAL'
4819 include 'COMMON.CHAIN'
4820 include 'COMMON.DERIV'
4821 include 'COMMON.INTERACT'
4822 include 'COMMON.CONTACTS'
4823 include 'COMMON.TORSION'
4824 include 'COMMON.VECTORS'
4825 include 'COMMON.FFIELD'
4826 include 'COMMON.CONTROL'
4827 include 'COMMON.SHIELD'
4829 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4830 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4831 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4832 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4833 & auxgmat2(2,2),auxgmatt2(2,2)
4834 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4835 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4836 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4837 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4840 c write (iout,*) "eturn3",i,j,j1,j2
4845 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4847 C Third-order contributions
4854 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4855 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4856 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4857 c auxalary matices for theta gradient
4858 c auxalary matrix for i+1 and constant i+2
4859 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4860 c auxalary matrix for i+2 and constant i+1
4861 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4862 call transpose2(auxmat(1,1),auxmat1(1,1))
4863 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4864 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4865 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4866 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4867 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4868 if (shield_mode.eq.0) then
4875 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4876 & *fac_shield(i)*fac_shield(j)
4877 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
4878 & *fac_shield(i)*fac_shield(j)
4879 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
4883 C Derivatives in theta
4884 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4885 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4886 & *fac_shield(i)*fac_shield(j)
4887 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4888 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4889 & *fac_shield(i)*fac_shield(j)
4892 C Derivatives in shield mode
4893 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4894 & (shield_mode.gt.0)) then
4897 do ilist=1,ishield_list(i)
4898 iresshield=shield_list(ilist,i)
4900 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4902 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4904 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4905 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4909 do ilist=1,ishield_list(j)
4910 iresshield=shield_list(ilist,j)
4912 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4914 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4916 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4917 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4924 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
4925 & grad_shield(k,i)*eello_t3/fac_shield(i)
4926 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
4927 & grad_shield(k,j)*eello_t3/fac_shield(j)
4928 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
4929 & grad_shield(k,i)*eello_t3/fac_shield(i)
4930 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
4931 & grad_shield(k,j)*eello_t3/fac_shield(j)
4935 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4936 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4937 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4938 cd & ' eello_turn3_num',4*eello_turn3_num
4939 C Derivatives in gamma(i)
4940 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4941 call transpose2(auxmat2(1,1),auxmat3(1,1))
4942 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4943 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4944 & *fac_shield(i)*fac_shield(j)
4945 C Derivatives in gamma(i+1)
4946 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4947 call transpose2(auxmat2(1,1),auxmat3(1,1))
4948 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4949 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4950 & +0.5d0*(pizda(1,1)+pizda(2,2))
4951 & *fac_shield(i)*fac_shield(j)
4952 C Cartesian derivatives
4954 c ghalf1=0.5d0*agg(l,1)
4955 c ghalf2=0.5d0*agg(l,2)
4956 c ghalf3=0.5d0*agg(l,3)
4957 c ghalf4=0.5d0*agg(l,4)
4958 a_temp(1,1)=aggi(l,1)!+ghalf1
4959 a_temp(1,2)=aggi(l,2)!+ghalf2
4960 a_temp(2,1)=aggi(l,3)!+ghalf3
4961 a_temp(2,2)=aggi(l,4)!+ghalf4
4962 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4963 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4964 & +0.5d0*(pizda(1,1)+pizda(2,2))
4965 & *fac_shield(i)*fac_shield(j)
4967 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4968 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4969 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4970 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4971 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4972 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4973 & +0.5d0*(pizda(1,1)+pizda(2,2))
4974 & *fac_shield(i)*fac_shield(j)
4975 a_temp(1,1)=aggj(l,1)!+ghalf1
4976 a_temp(1,2)=aggj(l,2)!+ghalf2
4977 a_temp(2,1)=aggj(l,3)!+ghalf3
4978 a_temp(2,2)=aggj(l,4)!+ghalf4
4979 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4980 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4981 & +0.5d0*(pizda(1,1)+pizda(2,2))
4982 & *fac_shield(i)*fac_shield(j)
4983 a_temp(1,1)=aggj1(l,1)
4984 a_temp(1,2)=aggj1(l,2)
4985 a_temp(2,1)=aggj1(l,3)
4986 a_temp(2,2)=aggj1(l,4)
4987 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4988 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4989 & +0.5d0*(pizda(1,1)+pizda(2,2))
4990 & *fac_shield(i)*fac_shield(j)
4997 C-------------------------------------------------------------------------------
4998 subroutine eturn4(i,eello_turn4)
4999 C Third- and fourth-order contributions from turns
5000 implicit real*8 (a-h,o-z)
5001 include 'DIMENSIONS'
5002 include 'DIMENSIONS.ZSCOPT'
5003 include 'COMMON.IOUNITS'
5004 include 'COMMON.GEO'
5005 include 'COMMON.VAR'
5006 include 'COMMON.LOCAL'
5007 include 'COMMON.CHAIN'
5008 include 'COMMON.DERIV'
5009 include 'COMMON.INTERACT'
5010 include 'COMMON.CONTACTS'
5011 include 'COMMON.TORSION'
5012 include 'COMMON.VECTORS'
5013 include 'COMMON.FFIELD'
5014 include 'COMMON.CONTROL'
5015 include 'COMMON.SHIELD'
5017 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5018 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5019 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
5020 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
5021 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
5022 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
5023 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
5024 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5025 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5026 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5027 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5030 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5032 C Fourth-order contributions
5040 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5041 cd call checkint_turn4(i,a_temp,eello_turn4_num)
5042 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5043 c write(iout,*)"WCHODZE W PROGRAM"
5048 iti1=itype2loc(itype(i+1))
5049 iti2=itype2loc(itype(i+2))
5050 iti3=itype2loc(itype(i+3))
5051 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5052 call transpose2(EUg(1,1,i+1),e1t(1,1))
5053 call transpose2(Eug(1,1,i+2),e2t(1,1))
5054 call transpose2(Eug(1,1,i+3),e3t(1,1))
5055 C Ematrix derivative in theta
5056 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
5057 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
5058 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
5059 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5060 c eta1 in derivative theta
5061 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
5062 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5063 c auxgvec is derivative of Ub2 so i+3 theta
5064 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
5065 c auxalary matrix of E i+1
5066 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
5069 s1=scalar2(b1(1,i+2),auxvec(1))
5070 c derivative of theta i+2 with constant i+3
5071 gs23=scalar2(gtb1(1,i+2),auxvec(1))
5072 c derivative of theta i+2 with constant i+2
5073 gs32=scalar2(b1(1,i+2),auxgvec(1))
5074 c derivative of E matix in theta of i+1
5075 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
5077 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5078 c ea31 in derivative theta
5079 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
5080 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5081 c auxilary matrix auxgvec of Ub2 with constant E matirx
5082 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
5083 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
5084 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
5088 s2=scalar2(b1(1,i+1),auxvec(1))
5089 c derivative of theta i+1 with constant i+3
5090 gs13=scalar2(gtb1(1,i+1),auxvec(1))
5091 c derivative of theta i+2 with constant i+1
5092 gs21=scalar2(b1(1,i+1),auxgvec(1))
5093 c derivative of theta i+3 with constant i+1
5094 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
5095 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
5097 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5098 c two derivatives over diffetent matrices
5099 c gtae3e2 is derivative over i+3
5100 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
5101 c ae3gte2 is derivative over i+2
5102 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5103 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5104 c three possible derivative over theta E matices
5106 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5108 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5110 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5111 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5113 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5114 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5115 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5116 if (shield_mode.eq.0) then
5123 eello_turn4=eello_turn4-(s1+s2+s3)
5124 & *fac_shield(i)*fac_shield(j)
5125 eello_t4=-(s1+s2+s3)
5126 & *fac_shield(i)*fac_shield(j)
5127 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
5128 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
5129 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
5130 C Now derivative over shield:
5131 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5132 & (shield_mode.gt.0)) then
5135 do ilist=1,ishield_list(i)
5136 iresshield=shield_list(ilist,i)
5138 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5140 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5142 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5143 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5147 do ilist=1,ishield_list(j)
5148 iresshield=shield_list(ilist,j)
5150 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5152 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5154 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5155 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5162 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
5163 & grad_shield(k,i)*eello_t4/fac_shield(i)
5164 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
5165 & grad_shield(k,j)*eello_t4/fac_shield(j)
5166 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
5167 & grad_shield(k,i)*eello_t4/fac_shield(i)
5168 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
5169 & grad_shield(k,j)*eello_t4/fac_shield(j)
5172 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5173 cd & ' eello_turn4_num',8*eello_turn4_num
5175 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5176 & -(gs13+gsE13+gsEE1)*wturn4
5177 & *fac_shield(i)*fac_shield(j)
5178 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
5179 & -(gs23+gs21+gsEE2)*wturn4
5180 & *fac_shield(i)*fac_shield(j)
5182 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
5183 & -(gs32+gsE31+gsEE3)*wturn4
5184 & *fac_shield(i)*fac_shield(j)
5186 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5189 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5190 & 'eturn4',i,j,-(s1+s2+s3)
5191 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5192 c & ' eello_turn4_num',8*eello_turn4_num
5193 C Derivatives in gamma(i)
5194 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5195 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5196 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5197 s1=scalar2(b1(1,i+2),auxvec(1))
5198 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5199 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5200 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5201 & *fac_shield(i)*fac_shield(j)
5202 C Derivatives in gamma(i+1)
5203 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5204 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5205 s2=scalar2(b1(1,i+1),auxvec(1))
5206 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5207 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5208 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5209 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5210 & *fac_shield(i)*fac_shield(j)
5211 C Derivatives in gamma(i+2)
5212 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5213 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5214 s1=scalar2(b1(1,i+2),auxvec(1))
5215 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5216 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5217 s2=scalar2(b1(1,i+1),auxvec(1))
5218 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5219 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5220 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5221 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5222 & *fac_shield(i)*fac_shield(j)
5224 C Cartesian derivatives
5225 C Derivatives of this turn contributions in DC(i+2)
5226 if (j.lt.nres-1) then
5228 a_temp(1,1)=agg(l,1)
5229 a_temp(1,2)=agg(l,2)
5230 a_temp(2,1)=agg(l,3)
5231 a_temp(2,2)=agg(l,4)
5232 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5233 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5234 s1=scalar2(b1(1,i+2),auxvec(1))
5235 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5236 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5237 s2=scalar2(b1(1,i+1),auxvec(1))
5238 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5239 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5240 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5242 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5243 & *fac_shield(i)*fac_shield(j)
5246 C Remaining derivatives of this turn contribution
5248 a_temp(1,1)=aggi(l,1)
5249 a_temp(1,2)=aggi(l,2)
5250 a_temp(2,1)=aggi(l,3)
5251 a_temp(2,2)=aggi(l,4)
5252 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5253 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5254 s1=scalar2(b1(1,i+2),auxvec(1))
5255 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5256 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5257 s2=scalar2(b1(1,i+1),auxvec(1))
5258 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5259 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5260 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5261 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5262 & *fac_shield(i)*fac_shield(j)
5263 a_temp(1,1)=aggi1(l,1)
5264 a_temp(1,2)=aggi1(l,2)
5265 a_temp(2,1)=aggi1(l,3)
5266 a_temp(2,2)=aggi1(l,4)
5267 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5268 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5269 s1=scalar2(b1(1,i+2),auxvec(1))
5270 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5271 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5272 s2=scalar2(b1(1,i+1),auxvec(1))
5273 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5274 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5275 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5276 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5277 & *fac_shield(i)*fac_shield(j)
5278 a_temp(1,1)=aggj(l,1)
5279 a_temp(1,2)=aggj(l,2)
5280 a_temp(2,1)=aggj(l,3)
5281 a_temp(2,2)=aggj(l,4)
5282 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5283 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5284 s1=scalar2(b1(1,i+2),auxvec(1))
5285 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5286 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5287 s2=scalar2(b1(1,i+1),auxvec(1))
5288 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5289 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5290 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5291 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5292 & *fac_shield(i)*fac_shield(j)
5293 a_temp(1,1)=aggj1(l,1)
5294 a_temp(1,2)=aggj1(l,2)
5295 a_temp(2,1)=aggj1(l,3)
5296 a_temp(2,2)=aggj1(l,4)
5297 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5298 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5299 s1=scalar2(b1(1,i+2),auxvec(1))
5300 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5301 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5302 s2=scalar2(b1(1,i+1),auxvec(1))
5303 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5304 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5305 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5306 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5307 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5308 & *fac_shield(i)*fac_shield(j)
5315 C-----------------------------------------------------------------------------
5316 subroutine vecpr(u,v,w)
5317 implicit real*8(a-h,o-z)
5318 dimension u(3),v(3),w(3)
5319 w(1)=u(2)*v(3)-u(3)*v(2)
5320 w(2)=-u(1)*v(3)+u(3)*v(1)
5321 w(3)=u(1)*v(2)-u(2)*v(1)
5324 C-----------------------------------------------------------------------------
5325 subroutine unormderiv(u,ugrad,unorm,ungrad)
5326 C This subroutine computes the derivatives of a normalized vector u, given
5327 C the derivatives computed without normalization conditions, ugrad. Returns
5330 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5331 double precision vec(3)
5332 double precision scalar
5334 c write (2,*) 'ugrad',ugrad
5337 vec(i)=scalar(ugrad(1,i),u(1))
5339 c write (2,*) 'vec',vec
5342 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5345 c write (2,*) 'ungrad',ungrad
5348 C-----------------------------------------------------------------------------
5349 subroutine escp(evdw2,evdw2_14)
5351 C This subroutine calculates the excluded-volume interaction energy between
5352 C peptide-group centers and side chains and its gradient in virtual-bond and
5353 C side-chain vectors.
5355 implicit real*8 (a-h,o-z)
5356 include 'DIMENSIONS'
5357 include 'DIMENSIONS.ZSCOPT'
5358 include 'COMMON.GEO'
5359 include 'COMMON.VAR'
5360 include 'COMMON.LOCAL'
5361 include 'COMMON.CHAIN'
5362 include 'COMMON.DERIV'
5363 include 'COMMON.INTERACT'
5364 include 'COMMON.FFIELD'
5365 include 'COMMON.IOUNITS'
5369 cd print '(a)','Enter ESCP'
5370 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
5371 c & ' scal14',scal14
5372 do i=iatscp_s,iatscp_e
5373 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5375 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
5376 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
5377 if (iteli.eq.0) goto 1225
5378 xi=0.5D0*(c(1,i)+c(1,i+1))
5379 yi=0.5D0*(c(2,i)+c(2,i+1))
5380 zi=0.5D0*(c(3,i)+c(3,i+1))
5381 C Returning the ith atom to box
5383 if (xi.lt.0) xi=xi+boxxsize
5385 if (yi.lt.0) yi=yi+boxysize
5387 if (zi.lt.0) zi=zi+boxzsize
5388 do iint=1,nscp_gr(i)
5390 do j=iscpstart(i,iint),iscpend(i,iint)
5391 itypj=iabs(itype(j))
5392 if (itypj.eq.ntyp1) cycle
5393 C Uncomment following three lines for SC-p interactions
5397 C Uncomment following three lines for Ca-p interactions
5401 C returning the jth atom to box
5403 if (xj.lt.0) xj=xj+boxxsize
5405 if (yj.lt.0) yj=yj+boxysize
5407 if (zj.lt.0) zj=zj+boxzsize
5408 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5413 C Finding the closest jth atom
5417 xj=xj_safe+xshift*boxxsize
5418 yj=yj_safe+yshift*boxysize
5419 zj=zj_safe+zshift*boxzsize
5420 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5421 if(dist_temp.lt.dist_init) then
5431 if (subchap.eq.1) then
5440 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5441 C sss is scaling function for smoothing the cutoff gradient otherwise
5442 C the gradient would not be continuouse
5443 sss=sscale(1.0d0/(dsqrt(rrij)))
5444 if (sss.le.0.0d0) cycle
5445 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5447 e1=fac*fac*aad(itypj,iteli)
5448 e2=fac*bad(itypj,iteli)
5449 if (iabs(j-i) .le. 2) then
5452 evdw2_14=evdw2_14+(e1+e2)*sss
5455 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5456 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5457 c & bad(itypj,iteli)
5458 evdw2=evdw2+evdwij*sss
5461 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5463 fac=-(evdwij+e1)*rrij*sss
5464 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5469 cd write (iout,*) 'j<i'
5470 C Uncomment following three lines for SC-p interactions
5472 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5475 cd write (iout,*) 'j>i'
5478 C Uncomment following line for SC-p interactions
5479 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5483 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5487 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5488 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5491 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5501 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5502 gradx_scp(j,i)=expon*gradx_scp(j,i)
5505 C******************************************************************************
5509 C To save time the factor EXPON has been extracted from ALL components
5510 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5513 C******************************************************************************
5516 C--------------------------------------------------------------------------
5517 subroutine edis(ehpb)
5519 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5521 implicit real*8 (a-h,o-z)
5522 include 'DIMENSIONS'
5523 include 'DIMENSIONS.ZSCOPT'
5524 include 'COMMON.SBRIDGE'
5525 include 'COMMON.CHAIN'
5526 include 'COMMON.DERIV'
5527 include 'COMMON.VAR'
5528 include 'COMMON.INTERACT'
5529 include 'COMMON.CONTROL'
5530 include 'COMMON.IOUNITS'
5533 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
5534 cd print *,'link_start=',link_start,' link_end=',link_end
5535 C write(iout,*) link_end, "link_end"
5536 if (link_end.eq.0) return
5537 do i=link_start,link_end
5538 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5539 C CA-CA distance used in regularization of structure.
5542 C iii and jjj point to the residues for which the distance is assigned.
5543 if (ii.gt.nres) then
5550 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5551 C distance and angle dependent SS bond potential.
5552 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5553 C & iabs(itype(jjj)).eq.1) then
5554 C write(iout,*) constr_dist,"const"
5555 if (.not.dyn_ss .and. i.le.nss) then
5556 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5557 & iabs(itype(jjj)).eq.1) then
5558 call ssbond_ene(iii,jjj,eij)
5561 else if (ii.gt.nres .and. jj.gt.nres) then
5562 c Restraints from contact prediction
5564 if (constr_dist.eq.11) then
5565 C ehpb=ehpb+fordepth(i)**4.0d0
5566 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5567 ehpb=ehpb+fordepth(i)**4.0d0
5568 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5569 fac=fordepth(i)**4.0d0
5570 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5571 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5572 C & ehpb,fordepth(i),dd
5573 C write(iout,*) ehpb,"atu?"
5575 C fac=fordepth(i)**4.0d0
5576 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5578 if (dhpb1(i).gt.0.0d0) then
5579 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5580 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5581 c write (iout,*) "beta nmr",
5582 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5586 C Get the force constant corresponding to this distance.
5588 C Calculate the contribution to energy.
5589 ehpb=ehpb+waga*rdis*rdis
5590 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5592 C Evaluate gradient.
5595 endif !end dhpb1(i).gt.0
5596 endif !end const_dist=11
5598 ggg(j)=fac*(c(j,jj)-c(j,ii))
5601 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5602 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5605 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5606 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5609 C write(iout,*) "before"
5611 C write(iout,*) "after",dd
5612 if (constr_dist.eq.11) then
5613 ehpb=ehpb+fordepth(i)**4.0d0
5614 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5615 fac=fordepth(i)**4.0d0
5616 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5617 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
5618 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
5619 C print *,ehpb,"tu?"
5620 C write(iout,*) ehpb,"btu?",
5621 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
5622 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5623 C & ehpb,fordepth(i),dd
5625 if (dhpb1(i).gt.0.0d0) then
5626 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5627 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5628 c write (iout,*) "alph nmr",
5629 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5632 C Get the force constant corresponding to this distance.
5634 C Calculate the contribution to energy.
5635 ehpb=ehpb+waga*rdis*rdis
5636 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5638 C Evaluate gradient.
5645 ggg(j)=fac*(c(j,jj)-c(j,ii))
5647 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5648 C If this is a SC-SC distance, we need to calculate the contributions to the
5649 C Cartesian gradient in the SC vectors (ghpbx).
5652 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5653 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5658 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5663 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5666 C--------------------------------------------------------------------------
5667 subroutine ssbond_ene(i,j,eij)
5669 C Calculate the distance and angle dependent SS-bond potential energy
5670 C using a free-energy function derived based on RHF/6-31G** ab initio
5671 C calculations of diethyl disulfide.
5673 C A. Liwo and U. Kozlowska, 11/24/03
5675 implicit real*8 (a-h,o-z)
5676 include 'DIMENSIONS'
5677 include 'DIMENSIONS.ZSCOPT'
5678 include 'COMMON.SBRIDGE'
5679 include 'COMMON.CHAIN'
5680 include 'COMMON.DERIV'
5681 include 'COMMON.LOCAL'
5682 include 'COMMON.INTERACT'
5683 include 'COMMON.VAR'
5684 include 'COMMON.IOUNITS'
5685 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5686 itypi=iabs(itype(i))
5690 dxi=dc_norm(1,nres+i)
5691 dyi=dc_norm(2,nres+i)
5692 dzi=dc_norm(3,nres+i)
5693 dsci_inv=dsc_inv(itypi)
5694 itypj=iabs(itype(j))
5695 dscj_inv=dsc_inv(itypj)
5699 dxj=dc_norm(1,nres+j)
5700 dyj=dc_norm(2,nres+j)
5701 dzj=dc_norm(3,nres+j)
5702 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5707 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5708 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5709 om12=dxi*dxj+dyi*dyj+dzi*dzj
5711 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5712 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5718 deltat12=om2-om1+2.0d0
5720 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5721 & +akct*deltad*deltat12
5722 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
5723 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5724 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5725 c & " deltat12",deltat12," eij",eij
5726 ed=2*akcm*deltad+akct*deltat12
5728 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5729 eom1=-2*akth*deltat1-pom1-om2*pom2
5730 eom2= 2*akth*deltat2+pom1-om1*pom2
5733 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5736 ghpbx(k,i)=ghpbx(k,i)-gg(k)
5737 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
5738 ghpbx(k,j)=ghpbx(k,j)+gg(k)
5739 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
5742 C Calculate the components of the gradient in DC and X
5746 ghpbc(l,k)=ghpbc(l,k)+gg(l)
5751 C--------------------------------------------------------------------------
5752 subroutine ebond(estr)
5754 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5756 implicit real*8 (a-h,o-z)
5757 include 'DIMENSIONS'
5758 include 'DIMENSIONS.ZSCOPT'
5759 include 'COMMON.LOCAL'
5760 include 'COMMON.GEO'
5761 include 'COMMON.INTERACT'
5762 include 'COMMON.DERIV'
5763 include 'COMMON.VAR'
5764 include 'COMMON.CHAIN'
5765 include 'COMMON.IOUNITS'
5766 include 'COMMON.NAMES'
5767 include 'COMMON.FFIELD'
5768 include 'COMMON.CONTROL'
5769 double precision u(3),ud(3)
5772 c write (iout,*) "distchainmax",distchainmax
5774 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5775 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5777 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5778 C & *dc(j,i-1)/vbld(i)
5780 C if (energy_dec) write(iout,*)
5781 C & "estr1",i,vbld(i),distchainmax,
5782 C & gnmr1(vbld(i),-1.0d0,distchainmax)
5784 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5785 diff = vbld(i)-vbldpDUM
5786 C write(iout,*) i,diff
5788 diff = vbld(i)-vbldp0
5789 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
5793 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5796 C write (iout,'(a7,i5,4f7.3)')
5797 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5799 estr=0.5d0*AKP*estr+estr1
5801 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5805 if (iti.ne.10 .and. iti.ne.ntyp1) then
5808 diff=vbld(i+nres)-vbldsc0(1,iti)
5809 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5810 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
5811 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5813 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5817 diff=vbld(i+nres)-vbldsc0(j,iti)
5818 ud(j)=aksc(j,iti)*diff
5819 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5833 uprod2=uprod2*u(k)*u(k)
5837 usumsqder=usumsqder+ud(j)*uprod2
5839 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
5840 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
5841 estr=estr+uprod/usum
5843 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5851 C--------------------------------------------------------------------------
5852 subroutine ebend(etheta,ethetacnstr)
5854 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5855 C angles gamma and its derivatives in consecutive thetas and gammas.
5857 implicit real*8 (a-h,o-z)
5858 include 'DIMENSIONS'
5859 include 'DIMENSIONS.ZSCOPT'
5860 include 'COMMON.LOCAL'
5861 include 'COMMON.GEO'
5862 include 'COMMON.INTERACT'
5863 include 'COMMON.DERIV'
5864 include 'COMMON.VAR'
5865 include 'COMMON.CHAIN'
5866 include 'COMMON.IOUNITS'
5867 include 'COMMON.NAMES'
5868 include 'COMMON.FFIELD'
5869 include 'COMMON.TORCNSTR'
5870 common /calcthet/ term1,term2,termm,diffak,ratak,
5871 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5872 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5873 double precision y(2),z(2)
5875 c time11=dexp(-2*time)
5878 c write (iout,*) "nres",nres
5879 c write (*,'(a,i2)') 'EBEND ICG=',icg
5880 c write (iout,*) ithet_start,ithet_end
5881 do i=ithet_start,ithet_end
5882 C if (itype(i-1).eq.ntyp1) cycle
5884 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5885 & .or.itype(i).eq.ntyp1) cycle
5886 C Zero the energy function and its derivative at 0 or pi.
5887 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5889 ichir1=isign(1,itype(i-2))
5890 ichir2=isign(1,itype(i))
5891 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5892 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5893 if (itype(i-1).eq.10) then
5894 itype1=isign(10,itype(i-2))
5895 ichir11=isign(1,itype(i-2))
5896 ichir12=isign(1,itype(i-2))
5897 itype2=isign(10,itype(i))
5898 ichir21=isign(1,itype(i))
5899 ichir22=isign(1,itype(i))
5906 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5910 c call proc_proc(phii,icrc)
5911 if (icrc.eq.1) phii=150.0
5922 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5926 c call proc_proc(phii1,icrc)
5927 if (icrc.eq.1) phii1=150.0
5939 C Calculate the "mean" value of theta from the part of the distribution
5940 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5941 C In following comments this theta will be referred to as t_c.
5942 thet_pred_mean=0.0d0
5944 athetk=athet(k,it,ichir1,ichir2)
5945 bthetk=bthet(k,it,ichir1,ichir2)
5947 athetk=athet(k,itype1,ichir11,ichir12)
5948 bthetk=bthet(k,itype2,ichir21,ichir22)
5950 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5952 c write (iout,*) "thet_pred_mean",thet_pred_mean
5953 dthett=thet_pred_mean*ssd
5954 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5955 c write (iout,*) "thet_pred_mean",thet_pred_mean
5956 C Derivatives of the "mean" values in gamma1 and gamma2.
5957 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5958 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5959 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5960 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5962 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5963 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5964 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5965 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5967 if (theta(i).gt.pi-delta) then
5968 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5970 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5971 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5972 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5974 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5976 else if (theta(i).lt.delta) then
5977 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5978 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5979 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5981 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5982 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5985 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5988 etheta=etheta+ethetai
5989 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5990 c & 'ebend',i,ethetai,theta(i),itype(i)
5991 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5992 c & rad2deg*phii,rad2deg*phii1,ethetai
5993 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5994 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5995 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5999 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6000 do i=1,ntheta_constr
6001 itheta=itheta_constr(i)
6002 thetiii=theta(itheta)
6003 difi=pinorm(thetiii-theta_constr0(i))
6004 if (difi.gt.theta_drange(i)) then
6005 difi=difi-theta_drange(i)
6006 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6007 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6008 & +for_thet_constr(i)*difi**3
6009 else if (difi.lt.-drange(i)) then
6011 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6012 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6013 & +for_thet_constr(i)*difi**3
6017 C if (energy_dec) then
6018 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6019 C & i,itheta,rad2deg*thetiii,
6020 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6021 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6022 C & gloc(itheta+nphi-2,icg)
6025 C Ufff.... We've done all this!!!
6028 C---------------------------------------------------------------------------
6029 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6031 implicit real*8 (a-h,o-z)
6032 include 'DIMENSIONS'
6033 include 'COMMON.LOCAL'
6034 include 'COMMON.IOUNITS'
6035 common /calcthet/ term1,term2,termm,diffak,ratak,
6036 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6037 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6038 C Calculate the contributions to both Gaussian lobes.
6039 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6040 C The "polynomial part" of the "standard deviation" of this part of
6044 sig=sig*thet_pred_mean+polthet(j,it)
6046 C Derivative of the "interior part" of the "standard deviation of the"
6047 C gamma-dependent Gaussian lobe in t_c.
6048 sigtc=3*polthet(3,it)
6050 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6053 C Set the parameters of both Gaussian lobes of the distribution.
6054 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6055 fac=sig*sig+sigc0(it)
6058 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6059 sigsqtc=-4.0D0*sigcsq*sigtc
6060 c print *,i,sig,sigtc,sigsqtc
6061 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6062 sigtc=-sigtc/(fac*fac)
6063 C Following variable is sigma(t_c)**(-2)
6064 sigcsq=sigcsq*sigcsq
6066 sig0inv=1.0D0/sig0i**2
6067 delthec=thetai-thet_pred_mean
6068 delthe0=thetai-theta0i
6069 term1=-0.5D0*sigcsq*delthec*delthec
6070 term2=-0.5D0*sig0inv*delthe0*delthe0
6071 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6072 C NaNs in taking the logarithm. We extract the largest exponent which is added
6073 C to the energy (this being the log of the distribution) at the end of energy
6074 C term evaluation for this virtual-bond angle.
6075 if (term1.gt.term2) then
6077 term2=dexp(term2-termm)
6081 term1=dexp(term1-termm)
6084 C The ratio between the gamma-independent and gamma-dependent lobes of
6085 C the distribution is a Gaussian function of thet_pred_mean too.
6086 diffak=gthet(2,it)-thet_pred_mean
6087 ratak=diffak/gthet(3,it)**2
6088 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6089 C Let's differentiate it in thet_pred_mean NOW.
6091 C Now put together the distribution terms to make complete distribution.
6092 termexp=term1+ak*term2
6093 termpre=sigc+ak*sig0i
6094 C Contribution of the bending energy from this theta is just the -log of
6095 C the sum of the contributions from the two lobes and the pre-exponential
6096 C factor. Simple enough, isn't it?
6097 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6098 C NOW the derivatives!!!
6099 C 6/6/97 Take into account the deformation.
6100 E_theta=(delthec*sigcsq*term1
6101 & +ak*delthe0*sig0inv*term2)/termexp
6102 E_tc=((sigtc+aktc*sig0i)/termpre
6103 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6104 & aktc*term2)/termexp)
6107 c-----------------------------------------------------------------------------
6108 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6109 implicit real*8 (a-h,o-z)
6110 include 'DIMENSIONS'
6111 include 'COMMON.LOCAL'
6112 include 'COMMON.IOUNITS'
6113 common /calcthet/ term1,term2,termm,diffak,ratak,
6114 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6115 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6116 delthec=thetai-thet_pred_mean
6117 delthe0=thetai-theta0i
6118 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6119 t3 = thetai-thet_pred_mean
6123 t14 = t12+t6*sigsqtc
6125 t21 = thetai-theta0i
6131 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6132 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6133 & *(-t12*t9-ak*sig0inv*t27)
6137 C--------------------------------------------------------------------------
6138 subroutine ebend(etheta)
6140 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6141 C angles gamma and its derivatives in consecutive thetas and gammas.
6142 C ab initio-derived potentials from
6143 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6145 implicit real*8 (a-h,o-z)
6146 include 'DIMENSIONS'
6147 include 'DIMENSIONS.ZSCOPT'
6148 include 'COMMON.LOCAL'
6149 include 'COMMON.GEO'
6150 include 'COMMON.INTERACT'
6151 include 'COMMON.DERIV'
6152 include 'COMMON.VAR'
6153 include 'COMMON.CHAIN'
6154 include 'COMMON.IOUNITS'
6155 include 'COMMON.NAMES'
6156 include 'COMMON.FFIELD'
6157 include 'COMMON.CONTROL'
6158 include 'COMMON.TORCNSTR'
6159 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6160 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6161 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6162 & sinph1ph2(maxdouble,maxdouble)
6163 logical lprn /.false./, lprn1 /.false./
6165 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
6166 do i=ithet_start,ithet_end
6168 C if (itype(i-1).eq.ntyp1) cycle
6170 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6171 & .or.itype(i).eq.ntyp1) cycle
6172 if (iabs(itype(i+1)).eq.20) iblock=2
6173 if (iabs(itype(i+1)).ne.20) iblock=1
6177 theti2=0.5d0*theta(i)
6178 ityp2=ithetyp((itype(i-1)))
6180 coskt(k)=dcos(k*theti2)
6181 sinkt(k)=dsin(k*theti2)
6191 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6194 if (phii.ne.phii) phii=150.0
6198 ityp1=ithetyp((itype(i-2)))
6200 cosph1(k)=dcos(k*phii)
6201 sinph1(k)=dsin(k*phii)
6207 ityp1=ithetyp((itype(i-2)))
6213 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6216 if (phii1.ne.phii1) phii1=150.0
6221 ityp3=ithetyp((itype(i)))
6223 cosph2(k)=dcos(k*phii1)
6224 sinph2(k)=dsin(k*phii1)
6229 ityp3=ithetyp((itype(i)))
6235 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
6236 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
6238 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6241 ccl=cosph1(l)*cosph2(k-l)
6242 ssl=sinph1(l)*sinph2(k-l)
6243 scl=sinph1(l)*cosph2(k-l)
6244 csl=cosph1(l)*sinph2(k-l)
6245 cosph1ph2(l,k)=ccl-ssl
6246 cosph1ph2(k,l)=ccl+ssl
6247 sinph1ph2(l,k)=scl+csl
6248 sinph1ph2(k,l)=scl-csl
6252 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6253 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6254 write (iout,*) "coskt and sinkt"
6256 write (iout,*) k,coskt(k),sinkt(k)
6260 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6261 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6264 & write (iout,*) "k",k,"
6265 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6266 & " ethetai",ethetai
6269 write (iout,*) "cosph and sinph"
6271 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6273 write (iout,*) "cosph1ph2 and sinph2ph2"
6276 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6277 & sinph1ph2(l,k),sinph1ph2(k,l)
6280 write(iout,*) "ethetai",ethetai
6284 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6285 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6286 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6287 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6288 ethetai=ethetai+sinkt(m)*aux
6289 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6290 dephii=dephii+k*sinkt(m)*(
6291 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6292 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6293 dephii1=dephii1+k*sinkt(m)*(
6294 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6295 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6297 & write (iout,*) "m",m," k",k," bbthet",
6298 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6299 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6300 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6301 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6305 & write(iout,*) "ethetai",ethetai
6309 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6310 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6311 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6312 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6313 ethetai=ethetai+sinkt(m)*aux
6314 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6315 dephii=dephii+l*sinkt(m)*(
6316 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6317 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6318 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6319 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6320 dephii1=dephii1+(k-l)*sinkt(m)*(
6321 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6322 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6323 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6324 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6326 write (iout,*) "m",m," k",k," l",l," ffthet",
6327 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6328 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6329 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6330 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6331 & " ethetai",ethetai
6332 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6333 & cosph1ph2(k,l)*sinkt(m),
6334 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6340 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6341 & i,theta(i)*rad2deg,phii*rad2deg,
6342 & phii1*rad2deg,ethetai
6343 etheta=etheta+ethetai
6344 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6345 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6346 c gloc(nphi+i-2,icg)=wang*dethetai
6347 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6353 c-----------------------------------------------------------------------------
6354 subroutine esc(escloc)
6355 C Calculate the local energy of a side chain and its derivatives in the
6356 C corresponding virtual-bond valence angles THETA and the spherical angles
6358 implicit real*8 (a-h,o-z)
6359 include 'DIMENSIONS'
6360 include 'DIMENSIONS.ZSCOPT'
6361 include 'COMMON.GEO'
6362 include 'COMMON.LOCAL'
6363 include 'COMMON.VAR'
6364 include 'COMMON.INTERACT'
6365 include 'COMMON.DERIV'
6366 include 'COMMON.CHAIN'
6367 include 'COMMON.IOUNITS'
6368 include 'COMMON.NAMES'
6369 include 'COMMON.FFIELD'
6370 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6371 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6372 common /sccalc/ time11,time12,time112,theti,it,nlobit
6375 C write (iout,*) 'ESC'
6376 do i=loc_start,loc_end
6378 if (it.eq.ntyp1) cycle
6379 if (it.eq.10) goto 1
6380 nlobit=nlob(iabs(it))
6381 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6382 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6383 theti=theta(i+1)-pipol
6387 c write (iout,*) "i",i," x",x(1),x(2),x(3)
6389 if (x(2).gt.pi-delta) then
6393 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6395 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6396 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6398 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6399 & ddersc0(1),dersc(1))
6400 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6401 & ddersc0(3),dersc(3))
6403 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6405 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6406 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6407 & dersc0(2),esclocbi,dersc02)
6408 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6410 call splinthet(x(2),0.5d0*delta,ss,ssd)
6415 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6417 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6418 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6420 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6422 c write (iout,*) escloci
6423 else if (x(2).lt.delta) then
6427 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6429 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6430 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6432 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6433 & ddersc0(1),dersc(1))
6434 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6435 & ddersc0(3),dersc(3))
6437 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6439 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6440 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6441 & dersc0(2),esclocbi,dersc02)
6442 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6447 call splinthet(x(2),0.5d0*delta,ss,ssd)
6449 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6451 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6452 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6454 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6455 C write (iout,*) 'i=',i, escloci
6457 call enesc(x,escloci,dersc,ddummy,.false.)
6460 escloc=escloc+escloci
6461 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6462 write (iout,'(a6,i5,0pf7.3)')
6463 & 'escloc',i,escloci
6465 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6467 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6468 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6473 C---------------------------------------------------------------------------
6474 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6475 implicit real*8 (a-h,o-z)
6476 include 'DIMENSIONS'
6477 include 'COMMON.GEO'
6478 include 'COMMON.LOCAL'
6479 include 'COMMON.IOUNITS'
6480 common /sccalc/ time11,time12,time112,theti,it,nlobit
6481 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6482 double precision contr(maxlob,-1:1)
6484 c write (iout,*) 'it=',it,' nlobit=',nlobit
6488 if (mixed) ddersc(j)=0.0d0
6492 C Because of periodicity of the dependence of the SC energy in omega we have
6493 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6494 C To avoid underflows, first compute & store the exponents.
6502 z(k)=x(k)-censc(k,j,it)
6507 Axk=Axk+gaussc(l,k,j,it)*z(l)
6513 expfac=expfac+Ax(k,j,iii)*z(k)
6521 C As in the case of ebend, we want to avoid underflows in exponentiation and
6522 C subsequent NaNs and INFs in energy calculation.
6523 C Find the largest exponent
6527 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6531 cd print *,'it=',it,' emin=',emin
6533 C Compute the contribution to SC energy and derivatives
6537 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6538 cd print *,'j=',j,' expfac=',expfac
6539 escloc_i=escloc_i+expfac
6541 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6545 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6546 & +gaussc(k,2,j,it))*expfac
6553 dersc(1)=dersc(1)/cos(theti)**2
6554 ddersc(1)=ddersc(1)/cos(theti)**2
6557 escloci=-(dlog(escloc_i)-emin)
6559 dersc(j)=dersc(j)/escloc_i
6563 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6568 C------------------------------------------------------------------------------
6569 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6570 implicit real*8 (a-h,o-z)
6571 include 'DIMENSIONS'
6572 include 'COMMON.GEO'
6573 include 'COMMON.LOCAL'
6574 include 'COMMON.IOUNITS'
6575 common /sccalc/ time11,time12,time112,theti,it,nlobit
6576 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6577 double precision contr(maxlob)
6588 z(k)=x(k)-censc(k,j,it)
6594 Axk=Axk+gaussc(l,k,j,it)*z(l)
6600 expfac=expfac+Ax(k,j)*z(k)
6605 C As in the case of ebend, we want to avoid underflows in exponentiation and
6606 C subsequent NaNs and INFs in energy calculation.
6607 C Find the largest exponent
6610 if (emin.gt.contr(j)) emin=contr(j)
6614 C Compute the contribution to SC energy and derivatives
6618 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6619 escloc_i=escloc_i+expfac
6621 dersc(k)=dersc(k)+Ax(k,j)*expfac
6623 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6624 & +gaussc(1,2,j,it))*expfac
6628 dersc(1)=dersc(1)/cos(theti)**2
6629 dersc12=dersc12/cos(theti)**2
6630 escloci=-(dlog(escloc_i)-emin)
6632 dersc(j)=dersc(j)/escloc_i
6634 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6638 c----------------------------------------------------------------------------------
6639 subroutine esc(escloc)
6640 C Calculate the local energy of a side chain and its derivatives in the
6641 C corresponding virtual-bond valence angles THETA and the spherical angles
6642 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6643 C added by Urszula Kozlowska. 07/11/2007
6645 implicit real*8 (a-h,o-z)
6646 include 'DIMENSIONS'
6647 include 'DIMENSIONS.ZSCOPT'
6648 include 'COMMON.GEO'
6649 include 'COMMON.LOCAL'
6650 include 'COMMON.VAR'
6651 include 'COMMON.SCROT'
6652 include 'COMMON.INTERACT'
6653 include 'COMMON.DERIV'
6654 include 'COMMON.CHAIN'
6655 include 'COMMON.IOUNITS'
6656 include 'COMMON.NAMES'
6657 include 'COMMON.FFIELD'
6658 include 'COMMON.CONTROL'
6659 include 'COMMON.VECTORS'
6660 double precision x_prime(3),y_prime(3),z_prime(3)
6661 & , sumene,dsc_i,dp2_i,x(65),
6662 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6663 & de_dxx,de_dyy,de_dzz,de_dt
6664 double precision s1_t,s1_6_t,s2_t,s2_6_t
6666 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6667 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6668 & dt_dCi(3),dt_dCi1(3)
6669 common /sccalc/ time11,time12,time112,theti,it,nlobit
6672 do i=loc_start,loc_end
6673 if (itype(i).eq.ntyp1) cycle
6674 costtab(i+1) =dcos(theta(i+1))
6675 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6676 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6677 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6678 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6679 cosfac=dsqrt(cosfac2)
6680 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6681 sinfac=dsqrt(sinfac2)
6683 if (it.eq.10) goto 1
6685 C Compute the axes of tghe local cartesian coordinates system; store in
6686 c x_prime, y_prime and z_prime
6693 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6694 C & dc_norm(3,i+nres)
6696 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6697 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6700 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6703 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6704 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6705 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6706 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6707 c & " xy",scalar(x_prime(1),y_prime(1)),
6708 c & " xz",scalar(x_prime(1),z_prime(1)),
6709 c & " yy",scalar(y_prime(1),y_prime(1)),
6710 c & " yz",scalar(y_prime(1),z_prime(1)),
6711 c & " zz",scalar(z_prime(1),z_prime(1))
6713 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6714 C to local coordinate system. Store in xx, yy, zz.
6720 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6721 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6722 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6729 C Compute the energy of the ith side cbain
6731 c write (2,*) "xx",xx," yy",yy," zz",zz
6734 x(j) = sc_parmin(j,it)
6737 Cc diagnostics - remove later
6739 yy1 = dsin(alph(2))*dcos(omeg(2))
6740 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
6741 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6742 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6744 C," --- ", xx_w,yy_w,zz_w
6747 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6748 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6750 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6751 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6753 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6754 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6755 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6756 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6757 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6759 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6760 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6761 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6762 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6763 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6765 dsc_i = 0.743d0+x(61)
6767 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6768 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6769 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6770 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6771 s1=(1+x(63))/(0.1d0 + dscp1)
6772 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6773 s2=(1+x(65))/(0.1d0 + dscp2)
6774 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6775 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6776 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6777 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6779 c & dscp1,dscp2,sumene
6780 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6781 escloc = escloc + sumene
6782 c write (2,*) "escloc",escloc
6783 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
6785 if (.not. calc_grad) goto 1
6788 C This section to check the numerical derivatives of the energy of ith side
6789 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6790 C #define DEBUG in the code to turn it on.
6792 write (2,*) "sumene =",sumene
6796 write (2,*) xx,yy,zz
6797 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6798 de_dxx_num=(sumenep-sumene)/aincr
6800 write (2,*) "xx+ sumene from enesc=",sumenep
6803 write (2,*) xx,yy,zz
6804 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6805 de_dyy_num=(sumenep-sumene)/aincr
6807 write (2,*) "yy+ sumene from enesc=",sumenep
6810 write (2,*) xx,yy,zz
6811 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6812 de_dzz_num=(sumenep-sumene)/aincr
6814 write (2,*) "zz+ sumene from enesc=",sumenep
6815 costsave=cost2tab(i+1)
6816 sintsave=sint2tab(i+1)
6817 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6818 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6819 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6820 de_dt_num=(sumenep-sumene)/aincr
6821 write (2,*) " t+ sumene from enesc=",sumenep
6822 cost2tab(i+1)=costsave
6823 sint2tab(i+1)=sintsave
6824 C End of diagnostics section.
6827 C Compute the gradient of esc
6829 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6830 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6831 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6832 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6833 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6834 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6835 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6836 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6837 pom1=(sumene3*sint2tab(i+1)+sumene1)
6838 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6839 pom2=(sumene4*cost2tab(i+1)+sumene2)
6840 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6841 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6842 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6843 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6845 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6846 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6847 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6849 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6850 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6851 & +(pom1+pom2)*pom_dx
6853 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
6856 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6857 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6858 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6860 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6861 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6862 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6863 & +x(59)*zz**2 +x(60)*xx*zz
6864 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6865 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6866 & +(pom1-pom2)*pom_dy
6868 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
6871 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6872 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6873 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6874 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6875 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6876 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6877 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6878 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6880 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
6883 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6884 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6885 & +pom1*pom_dt1+pom2*pom_dt2
6887 write(2,*), "de_dt = ", de_dt,de_dt_num
6891 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6892 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6893 cosfac2xx=cosfac2*xx
6894 sinfac2yy=sinfac2*yy
6896 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6898 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6900 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6901 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6902 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6903 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6904 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6905 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6906 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6907 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6908 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6909 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6913 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6914 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6915 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6916 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6919 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6920 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6921 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
6923 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6924 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6928 dXX_Ctab(k,i)=dXX_Ci(k)
6929 dXX_C1tab(k,i)=dXX_Ci1(k)
6930 dYY_Ctab(k,i)=dYY_Ci(k)
6931 dYY_C1tab(k,i)=dYY_Ci1(k)
6932 dZZ_Ctab(k,i)=dZZ_Ci(k)
6933 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6934 dXX_XYZtab(k,i)=dXX_XYZ(k)
6935 dYY_XYZtab(k,i)=dYY_XYZ(k)
6936 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6940 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6941 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6942 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6943 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6944 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6946 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6947 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6948 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6949 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6950 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6951 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6952 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6953 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6955 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6956 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6958 C to check gradient call subroutine check_grad
6965 c------------------------------------------------------------------------------
6966 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6968 C This procedure calculates two-body contact function g(rij) and its derivative:
6971 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6974 C where x=(rij-r0ij)/delta
6976 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6979 double precision rij,r0ij,eps0ij,fcont,fprimcont
6980 double precision x,x2,x4,delta
6984 if (x.lt.-1.0D0) then
6987 else if (x.le.1.0D0) then
6990 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6991 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6998 c------------------------------------------------------------------------------
6999 subroutine splinthet(theti,delta,ss,ssder)
7000 implicit real*8 (a-h,o-z)
7001 include 'DIMENSIONS'
7002 include 'DIMENSIONS.ZSCOPT'
7003 include 'COMMON.VAR'
7004 include 'COMMON.GEO'
7007 if (theti.gt.pipol) then
7008 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7010 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7015 c------------------------------------------------------------------------------
7016 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7018 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7019 double precision ksi,ksi2,ksi3,a1,a2,a3
7020 a1=fprim0*delta/(f1-f0)
7026 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7027 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7030 c------------------------------------------------------------------------------
7031 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7033 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7034 double precision ksi,ksi2,ksi3,a1,a2,a3
7039 a2=3*(f1x-f0x)-2*fprim0x*delta
7040 a3=fprim0x*delta-2*(f1x-f0x)
7041 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7044 C-----------------------------------------------------------------------------
7046 C-----------------------------------------------------------------------------
7047 subroutine etor(etors)
7048 implicit real*8 (a-h,o-z)
7049 include 'DIMENSIONS'
7050 include 'DIMENSIONS.ZSCOPT'
7051 include 'COMMON.VAR'
7052 include 'COMMON.GEO'
7053 include 'COMMON.LOCAL'
7054 include 'COMMON.TORSION'
7055 include 'COMMON.INTERACT'
7056 include 'COMMON.DERIV'
7057 include 'COMMON.CHAIN'
7058 include 'COMMON.NAMES'
7059 include 'COMMON.IOUNITS'
7060 include 'COMMON.FFIELD'
7061 include 'COMMON.TORCNSTR'
7063 C Set lprn=.true. for debugging
7067 do i=iphi_start,iphi_end
7068 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
7069 & .or. itype(i).eq.ntyp1) cycle
7070 itori=itortyp(itype(i-2))
7071 itori1=itortyp(itype(i-1))
7074 C Proline-Proline pair is a special case...
7075 if (itori.eq.3 .and. itori1.eq.3) then
7076 if (phii.gt.-dwapi3) then
7078 fac=1.0D0/(1.0D0-cosphi)
7079 etorsi=v1(1,3,3)*fac
7080 etorsi=etorsi+etorsi
7081 etors=etors+etorsi-v1(1,3,3)
7082 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7085 v1ij=v1(j+1,itori,itori1)
7086 v2ij=v2(j+1,itori,itori1)
7089 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7090 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7094 v1ij=v1(j,itori,itori1)
7095 v2ij=v2(j,itori,itori1)
7098 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7099 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7103 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7104 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7105 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7106 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7107 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7111 c------------------------------------------------------------------------------
7113 subroutine etor(etors)
7114 implicit real*8 (a-h,o-z)
7115 include 'DIMENSIONS'
7116 include 'DIMENSIONS.ZSCOPT'
7117 include 'COMMON.VAR'
7118 include 'COMMON.GEO'
7119 include 'COMMON.LOCAL'
7120 include 'COMMON.TORSION'
7121 include 'COMMON.INTERACT'
7122 include 'COMMON.DERIV'
7123 include 'COMMON.CHAIN'
7124 include 'COMMON.NAMES'
7125 include 'COMMON.IOUNITS'
7126 include 'COMMON.FFIELD'
7127 include 'COMMON.TORCNSTR'
7128 include 'COMMON.WEIGHTS'
7129 include 'COMMON.WEIGHTDER'
7131 C Set lprn=.true. for debugging
7140 etor_temp(l,k,j,i,iblock)=0.0d0
7146 do i=iphi_start,iphi_end
7148 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7149 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7150 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
7151 if (iabs(itype(i)).eq.20) then
7156 itori=itortyp(itype(i-2))
7157 itori1=itortyp(itype(i-1))
7158 weitori=weitor(0,itori,itori1,iblock)
7162 C Regular cosine and sine terms
7163 do j=1,nterm(itori,itori1,iblock)
7164 v1ij=v1(j,itori,itori1,iblock)
7165 v2ij=v2(j,itori,itori1,iblock)
7168 etori=etori+v1ij*cosphi+v2ij*sinphi
7169 etor_temp(j,0,itori,itori1,iblock)=
7170 & etor_temp(j,0,itori,itori1,iblock)+cosphi*ww(13)
7171 etor_temp(nterm(itori,itori1,iblock)+j,0,itori,itori1,iblock)=
7172 & etor_temp(nterm(itori,itori1,iblock)+j,0,itori,itori1,iblock)+
7174 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7178 C E = SUM ----------------------------------- - v1
7179 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7181 cosphi=dcos(0.5d0*phii)
7182 sinphi=dsin(0.5d0*phii)
7183 do j=1,nlor(itori,itori1,iblock)
7184 vl1ij=vlor1(j,itori,itori1)
7185 vl2ij=vlor2(j,itori,itori1)
7186 vl3ij=vlor3(j,itori,itori1)
7187 pom=vl2ij*cosphi+vl3ij*sinphi
7188 pom1=1.0d0/(pom*pom+1.0d0)
7189 etori=etori+vl1ij*pom1
7191 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7193 C Subtract the constant term
7194 etors=etors+(etori-v0(itori,itori1,iblock))*weitori
7195 etor_temp(0,0,itori,itori1,1)=etor_temp(0,0,itori,itori1,1)+
7196 & (etori-v0(itori,itori1,iblock))*ww(13)
7199 write (iout,'(2(a3,2x,i3,2x),2i3,8f8.3/26x,6f8.3/)')
7200 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7201 & weitori,v0(itori,itori1,iblock)*weitori,
7202 & (v1(j,itori,itori1,iblock)*weitori,
7203 & j=1,6),(v2(j,itori,itori1,iblock)*weitori,j=1,6)
7204 write (iout,*) "typ",itori,iloctyp(itori),itori1,
7205 & iloctyp(itori1)," etor_temp",
7206 & etor_temp(0,0,itori,itori1,1)
7209 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7210 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7215 c----------------------------------------------------------------------------
7216 subroutine etor_d(etors_d)
7217 C 6/23/01 Compute double torsional energy
7218 implicit real*8 (a-h,o-z)
7219 include 'DIMENSIONS'
7220 include 'DIMENSIONS.ZSCOPT'
7221 include 'COMMON.VAR'
7222 include 'COMMON.GEO'
7223 include 'COMMON.LOCAL'
7224 include 'COMMON.TORSION'
7225 include 'COMMON.INTERACT'
7226 include 'COMMON.DERIV'
7227 include 'COMMON.CHAIN'
7228 include 'COMMON.NAMES'
7229 include 'COMMON.IOUNITS'
7230 include 'COMMON.FFIELD'
7231 include 'COMMON.TORCNSTR'
7233 C Set lprn=.true. for debugging
7237 do i=iphi_start,iphi_end-1
7239 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7240 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
7241 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7242 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7243 & (itype(i+1).eq.ntyp1)) cycle
7244 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
7246 itori=itortyp(itype(i-2))
7247 itori1=itortyp(itype(i-1))
7248 itori2=itortyp(itype(i))
7254 if (iabs(itype(i+1)).eq.20) iblock=2
7255 C Regular cosine and sine terms
7256 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7257 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7258 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7259 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7260 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7261 cosphi1=dcos(j*phii)
7262 sinphi1=dsin(j*phii)
7263 cosphi2=dcos(j*phii1)
7264 sinphi2=dsin(j*phii1)
7265 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7266 & v2cij*cosphi2+v2sij*sinphi2
7267 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7268 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7270 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7272 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7273 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7274 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7275 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7276 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7277 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7278 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7279 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7280 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7281 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7282 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7283 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7284 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7285 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7288 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7289 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7295 c---------------------------------------------------------------------------
7296 C The rigorous attempt to derive energy function
7297 subroutine etor_kcc(etors)
7298 implicit real*8 (a-h,o-z)
7299 include 'DIMENSIONS'
7300 include 'DIMENSIONS.ZSCOPT'
7301 include 'COMMON.VAR'
7302 include 'COMMON.GEO'
7303 include 'COMMON.LOCAL'
7304 include 'COMMON.TORSION'
7305 include 'COMMON.INTERACT'
7306 include 'COMMON.DERIV'
7307 include 'COMMON.CHAIN'
7308 include 'COMMON.NAMES'
7309 include 'COMMON.IOUNITS'
7310 include 'COMMON.FFIELD'
7311 include 'COMMON.TORCNSTR'
7312 include 'COMMON.CONTROL'
7313 include 'COMMON.WEIGHTS'
7314 include 'COMMON.WEIGHTDER'
7315 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
7317 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7318 C Set lprn=.true. for debugging
7321 if (lprn) write (iout,*)"ETOR_KCC"
7327 etor_temp(l,k,j,i,iblock)=0.0d0
7338 etor_temp_kcc(ll,l,k,j,i)=0.0d0
7344 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7346 do i=iphi_start,iphi_end
7347 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7348 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7349 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7350 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7351 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7352 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7353 itori=itortyp(itype(i-2))
7354 itori1=itortyp(itype(i-1))
7355 weitori=weitor(0,itori,itori1,1)
7356 if (lprn) write (iout,*) i-2,i-2,itori,itori1,"weitor",weitori
7361 C to avoid multiple devision by 2
7362 c theti22=0.5d0*theta(i)
7363 C theta 12 is the theta_1 /2
7364 C theta 22 is theta_2 /2
7365 c theti12=0.5d0*theta(i-1)
7366 C and appropriate sinus function
7367 sinthet1=dsin(theta(i-1))
7368 sinthet2=dsin(theta(i))
7369 costhet1=dcos(theta(i-1))
7370 costhet2=dcos(theta(i))
7371 C to speed up lets store its mutliplication
7372 sint1t2=sinthet2*sinthet1
7374 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7375 C +d_n*sin(n*gamma)) *
7376 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7377 C we have two sum 1) Non-Chebyshev which is with n and gamma
7378 nval=nterm_kcc_Tb(itori,itori1)
7384 c1(j)=c1(j-1)*costhet1
7385 c2(j)=c2(j-1)*costhet2
7388 do j=1,nterm_kcc(itori,itori1)
7392 sint1t2n=sint1t2n*sint1t2
7398 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7399 etor_temp_kcc(l,k,j,itori,itori1)=
7400 & etor_temp_kcc(l,k,j,itori,itori1)+
7401 & c1(k)*c2(l)*sint1t2n*cosphi*ww(13)
7402 gradvalct1=gradvalct1+
7403 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7404 gradvalct2=gradvalct2+
7405 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7408 gradvalct1=-gradvalct1*sinthet1
7409 gradvalct2=-gradvalct2*sinthet2
7415 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7416 etor_temp_kcc(l,k,j+nterm_kcc(itori,itori1),itori,itori1)=
7417 & etor_temp_kcc(l,k,j+nterm_kcc(itori,itori1),itori,itori1)+
7418 & c1(k)*c2(l)*sint1t2n*sinphi*ww(13)
7419 gradvalst1=gradvalst1+
7420 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7421 gradvalst2=gradvalst2+
7422 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7425 gradvalst1=-gradvalst1*sinthet1
7426 gradvalst2=-gradvalst2*sinthet2
7427 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
7428 etor_temp(0,0,itori,itori1,1)=etor_temp(0,0,itori,itori1,1)
7429 & +sint1t2n*(sumvalc*cosphi+sumvals*sinphi)*ww(13)
7430 C glocig is the gradient local i site in gamma
7431 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
7432 C now gradient over theta_1
7433 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
7434 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
7435 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
7436 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
7438 etors=etors+etori*weitori
7439 C derivative over gamma
7440 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7441 C derivative over theta1
7442 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7443 C now derivative over theta2
7444 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7446 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
7447 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7451 c---------------------------------------------------------------------------------------------
7452 subroutine etor_constr(edihcnstr)
7453 implicit real*8 (a-h,o-z)
7454 include 'DIMENSIONS'
7455 include 'DIMENSIONS.ZSCOPT'
7456 include 'COMMON.VAR'
7457 include 'COMMON.GEO'
7458 include 'COMMON.LOCAL'
7459 include 'COMMON.TORSION'
7460 include 'COMMON.INTERACT'
7461 include 'COMMON.DERIV'
7462 include 'COMMON.CHAIN'
7463 include 'COMMON.NAMES'
7464 include 'COMMON.IOUNITS'
7465 include 'COMMON.FFIELD'
7466 include 'COMMON.TORCNSTR'
7467 include 'COMMON.CONTROL'
7468 ! 6/20/98 - dihedral angle constraints
7470 c do i=1,ndih_constr
7471 c write (iout,*) "idihconstr_start",idihconstr_start,
7472 c & " idihconstr_end",idihconstr_end
7473 do i=idihconstr_start,idihconstr_end
7474 itori=idih_constr(i)
7476 difi=pinorm(phii-phi0(i))
7477 if (difi.gt.drange(i)) then
7479 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7480 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7481 else if (difi.lt.-drange(i)) then
7483 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7484 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7491 c----------------------------------------------------------------------------
7492 C The rigorous attempt to derive energy function
7493 subroutine ebend_kcc(etheta)
7495 implicit real*8 (a-h,o-z)
7496 include 'DIMENSIONS'
7497 include 'DIMENSIONS.ZSCOPT'
7498 include 'COMMON.VAR'
7499 include 'COMMON.GEO'
7500 include 'COMMON.LOCAL'
7501 include 'COMMON.TORSION'
7502 include 'COMMON.INTERACT'
7503 include 'COMMON.DERIV'
7504 include 'COMMON.CHAIN'
7505 include 'COMMON.NAMES'
7506 include 'COMMON.IOUNITS'
7507 include 'COMMON.FFIELD'
7508 include 'COMMON.TORCNSTR'
7509 include 'COMMON.CONTROL'
7510 include 'COMMON.WEIGHTDER'
7512 double precision thybt1(maxang_kcc)
7513 C Set lprn=.true. for debugging
7516 C print *,"wchodze kcc"
7517 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7520 ebend_temp_kcc(j,i)=0.0d0
7524 do i=ithet_start,ithet_end
7525 c print *,i,itype(i-1),itype(i),itype(i-2)
7526 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
7527 & .or.itype(i).eq.ntyp1) cycle
7528 iti=iabs(itortyp(itype(i-1)))
7529 sinthet=dsin(theta(i))
7530 costhet=dcos(theta(i))
7531 do j=1,nbend_kcc_Tb(iti)
7532 thybt1(j)=v1bend_chyb(j,iti)
7533 ebend_temp_kcc(j,iabs(iti))=
7534 & ebend_temp_kcc(j,iabs(iti))+dcos(j*theta(i))
7536 sumth1thyb=v1bend_chyb(0,iti)+
7537 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7538 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
7540 ihelp=nbend_kcc_Tb(iti)-1
7541 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
7542 etheta=etheta+sumth1thyb
7543 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7544 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
7548 c-------------------------------------------------------------------------------------
7549 subroutine etheta_constr(ethetacnstr)
7551 implicit real*8 (a-h,o-z)
7552 include 'DIMENSIONS'
7553 include 'DIMENSIONS.ZSCOPT'
7554 include 'COMMON.VAR'
7555 include 'COMMON.GEO'
7556 include 'COMMON.LOCAL'
7557 include 'COMMON.TORSION'
7558 include 'COMMON.INTERACT'
7559 include 'COMMON.DERIV'
7560 include 'COMMON.CHAIN'
7561 include 'COMMON.NAMES'
7562 include 'COMMON.IOUNITS'
7563 include 'COMMON.FFIELD'
7564 include 'COMMON.TORCNSTR'
7565 include 'COMMON.CONTROL'
7567 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7568 do i=ithetaconstr_start,ithetaconstr_end
7569 itheta=itheta_constr(i)
7570 thetiii=theta(itheta)
7571 difi=pinorm(thetiii-theta_constr0(i))
7572 if (difi.gt.theta_drange(i)) then
7573 difi=difi-theta_drange(i)
7574 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7575 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7576 & +for_thet_constr(i)*difi**3
7577 else if (difi.lt.-drange(i)) then
7579 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7580 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7581 & +for_thet_constr(i)*difi**3
7585 if (energy_dec) then
7586 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
7587 & i,itheta,rad2deg*thetiii,
7588 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
7589 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
7590 & gloc(itheta+nphi-2,icg)
7595 c------------------------------------------------------------------------------
7596 subroutine eback_sc_corr(esccor)
7597 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7598 c conformational states; temporarily implemented as differences
7599 c between UNRES torsional potentials (dependent on three types of
7600 c residues) and the torsional potentials dependent on all 20 types
7601 c of residues computed from AM1 energy surfaces of terminally-blocked
7602 c amino-acid residues.
7603 implicit real*8 (a-h,o-z)
7604 include 'DIMENSIONS'
7605 include 'DIMENSIONS.ZSCOPT'
7606 include 'COMMON.VAR'
7607 include 'COMMON.GEO'
7608 include 'COMMON.LOCAL'
7609 include 'COMMON.TORSION'
7610 include 'COMMON.SCCOR'
7611 include 'COMMON.INTERACT'
7612 include 'COMMON.DERIV'
7613 include 'COMMON.CHAIN'
7614 include 'COMMON.NAMES'
7615 include 'COMMON.IOUNITS'
7616 include 'COMMON.FFIELD'
7617 include 'COMMON.CONTROL'
7619 C Set lprn=.true. for debugging
7622 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
7624 do i=itau_start,itau_end
7625 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7627 isccori=isccortyp(itype(i-2))
7628 isccori1=isccortyp(itype(i-1))
7630 do intertyp=1,3 !intertyp
7631 cc Added 09 May 2012 (Adasko)
7632 cc Intertyp means interaction type of backbone mainchain correlation:
7633 c 1 = SC...Ca...Ca...Ca
7634 c 2 = Ca...Ca...Ca...SC
7635 c 3 = SC...Ca...Ca...SCi
7637 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7638 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7639 & (itype(i-1).eq.ntyp1)))
7640 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7641 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7642 & .or.(itype(i).eq.ntyp1)))
7643 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7644 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7645 & (itype(i-3).eq.ntyp1)))) cycle
7646 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7647 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7649 do j=1,nterm_sccor(isccori,isccori1)
7650 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7651 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7652 cosphi=dcos(j*tauangle(intertyp,i))
7653 sinphi=dsin(j*tauangle(intertyp,i))
7654 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7655 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7657 C write (iout,*)"EBACK_SC_COR",esccor,i
7658 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
7659 c & nterm_sccor(isccori,isccori1),isccori,isccori1
7660 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7662 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7663 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7664 & (v1sccor(j,1,itori,itori1),j=1,6)
7665 & ,(v2sccor(j,1,itori,itori1),j=1,6)
7666 c gsccor_loc(i-3)=gloci
7671 c------------------------------------------------------------------------------
7672 subroutine multibody(ecorr)
7673 C This subroutine calculates multi-body contributions to energy following
7674 C the idea of Skolnick et al. If side chains I and J make a contact and
7675 C at the same time side chains I+1 and J+1 make a contact, an extra
7676 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7677 implicit real*8 (a-h,o-z)
7678 include 'DIMENSIONS'
7679 include 'DIMENSIONS.ZSCOPT'
7680 include 'COMMON.IOUNITS'
7681 include 'COMMON.DERIV'
7682 include 'COMMON.INTERACT'
7683 include 'COMMON.CONTACTS'
7684 double precision gx(3),gx1(3)
7687 C Set lprn=.true. for debugging
7691 write (iout,'(a)') 'Contact function values:'
7693 write (iout,'(i2,20(1x,i2,f10.5))')
7694 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7709 num_conti=num_cont(i)
7710 num_conti1=num_cont(i1)
7715 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7716 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7717 cd & ' ishift=',ishift
7718 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7719 C The system gains extra energy.
7720 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7721 endif ! j1==j+-ishift
7730 c------------------------------------------------------------------------------
7731 double precision function esccorr(i,j,k,l,jj,kk)
7732 implicit real*8 (a-h,o-z)
7733 include 'DIMENSIONS'
7734 include 'DIMENSIONS.ZSCOPT'
7735 include 'COMMON.IOUNITS'
7736 include 'COMMON.DERIV'
7737 include 'COMMON.INTERACT'
7738 include 'COMMON.CONTACTS'
7739 double precision gx(3),gx1(3)
7744 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7745 C Calculate the multi-body contribution to energy.
7746 C Calculate multi-body contributions to the gradient.
7747 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7748 cd & k,l,(gacont(m,kk,k),m=1,3)
7750 gx(m) =ekl*gacont(m,jj,i)
7751 gx1(m)=eij*gacont(m,kk,k)
7752 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7753 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7754 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7755 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7759 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7764 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7770 c------------------------------------------------------------------------------
7771 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7772 C This subroutine calculates multi-body contributions to hydrogen-bonding
7773 implicit real*8 (a-h,o-z)
7774 include 'DIMENSIONS'
7775 include 'DIMENSIONS.ZSCOPT'
7776 include 'COMMON.IOUNITS'
7777 include 'COMMON.FFIELD'
7778 include 'COMMON.DERIV'
7779 include 'COMMON.INTERACT'
7780 include 'COMMON.CONTACTS'
7781 double precision gx(3),gx1(3)
7784 C Set lprn=.true. for debugging
7787 write (iout,'(a)') 'Contact function values:'
7789 write (iout,'(2i3,50(1x,i2,f5.2))')
7790 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7791 & j=1,num_cont_hb(i))
7795 C Remove the loop below after debugging !!!
7802 C Calculate the local-electrostatic correlation terms
7803 do i=iatel_s,iatel_e+1
7805 num_conti=num_cont_hb(i)
7806 num_conti1=num_cont_hb(i+1)
7811 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7812 c & ' jj=',jj,' kk=',kk
7813 if (j1.eq.j+1 .or. j1.eq.j-1) then
7814 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7815 C The system gains extra energy.
7816 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7818 else if (j1.eq.j) then
7819 C Contacts I-J and I-(J+1) occur simultaneously.
7820 C The system loses extra energy.
7821 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7826 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7827 c & ' jj=',jj,' kk=',kk
7829 C Contacts I-J and (I+1)-J occur simultaneously.
7830 C The system loses extra energy.
7831 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7838 c------------------------------------------------------------------------------
7839 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7841 C This subroutine calculates multi-body contributions to hydrogen-bonding
7842 implicit real*8 (a-h,o-z)
7843 include 'DIMENSIONS'
7844 include 'DIMENSIONS.ZSCOPT'
7845 include 'COMMON.IOUNITS'
7849 include 'COMMON.FFIELD'
7850 include 'COMMON.DERIV'
7851 include 'COMMON.LOCAL'
7852 include 'COMMON.INTERACT'
7853 include 'COMMON.CONTACTS'
7854 include 'COMMON.CHAIN'
7855 include 'COMMON.CONTROL'
7856 include 'COMMON.SHIELD'
7857 double precision gx(3),gx1(3)
7858 integer num_cont_hb_old(maxres)
7860 double precision eello4,eello5,eelo6,eello_turn6
7861 external eello4,eello5,eello6,eello_turn6
7862 C Set lprn=.true. for debugging
7866 write (iout,'(a)') 'Contact function values:'
7868 write (iout,'(2i3,50(1x,i2,5f6.3))')
7869 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7870 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7876 C Remove the loop below after debugging !!!
7883 C Calculate the dipole-dipole interaction energies
7884 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7885 do i=iatel_s,iatel_e+1
7886 num_conti=num_cont_hb(i)
7895 C Calculate the local-electrostatic correlation terms
7896 c write (iout,*) "gradcorr5 in eello5 before loop"
7898 c write (iout,'(i5,3f10.5)')
7899 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7901 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7902 c write (iout,*) "corr loop i",i
7904 num_conti=num_cont_hb(i)
7905 num_conti1=num_cont_hb(i+1)
7912 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7913 c & ' jj=',jj,' kk=',kk
7914 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7915 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7916 & .or. j.lt.0 .and. j1.gt.0) .and.
7917 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7918 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7919 C The system gains extra energy.
7921 sqd1=dsqrt(d_cont(jj,i))
7922 sqd2=dsqrt(d_cont(kk,i1))
7923 sred_geom = sqd1*sqd2
7924 IF (sred_geom.lt.cutoff_corr) THEN
7925 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7927 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7928 cd & ' jj=',jj,' kk=',kk
7929 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7930 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7932 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7933 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7936 cd write (iout,*) 'sred_geom=',sred_geom,
7937 cd & ' ekont=',ekont,' fprim=',fprimcont,
7938 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7939 cd write (iout,*) "g_contij",g_contij
7940 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7941 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7942 call calc_eello(i,jp,i+1,jp1,jj,kk)
7943 if (wcorr4.gt.0.0d0)
7944 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7945 CC & *fac_shield(i)**2*fac_shield(j)**2
7946 if (energy_dec.and.wcorr4.gt.0.0d0)
7947 1 write (iout,'(a6,4i5,0pf7.3)')
7948 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7949 c write (iout,*) "gradcorr5 before eello5"
7951 c write (iout,'(i5,3f10.5)')
7952 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7954 if (wcorr5.gt.0.0d0)
7955 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7956 c write (iout,*) "gradcorr5 after eello5"
7958 c write (iout,'(i5,3f10.5)')
7959 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7961 if (energy_dec.and.wcorr5.gt.0.0d0)
7962 1 write (iout,'(a6,4i5,0pf7.3)')
7963 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7964 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7965 cd write(2,*)'ijkl',i,jp,i+1,jp1
7966 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7967 & .or. wturn6.eq.0.0d0))then
7968 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7969 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7970 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7971 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7972 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7973 cd & 'ecorr6=',ecorr6
7974 cd write (iout,'(4e15.5)') sred_geom,
7975 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7976 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7977 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7978 else if (wturn6.gt.0.0d0
7979 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7980 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7981 eturn6=eturn6+eello_turn6(i,jj,kk)
7982 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7983 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7984 cd write (2,*) 'multibody_eello:eturn6',eturn6
7993 num_cont_hb(i)=num_cont_hb_old(i)
7995 c write (iout,*) "gradcorr5 in eello5"
7997 c write (iout,'(i5,3f10.5)')
7998 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8002 c------------------------------------------------------------------------------
8003 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8004 implicit real*8 (a-h,o-z)
8005 include 'DIMENSIONS'
8006 include 'DIMENSIONS.ZSCOPT'
8007 include 'COMMON.IOUNITS'
8008 include 'COMMON.DERIV'
8009 include 'COMMON.INTERACT'
8010 include 'COMMON.CONTACTS'
8011 include 'COMMON.SHIELD'
8012 include 'COMMON.CONTROL'
8013 double precision gx(3),gx1(3)
8016 C print *,"wchodze",fac_shield(i),shield_mode
8024 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8026 C & fac_shield(i)**2*fac_shield(j)**2
8027 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8028 C Following 4 lines for diagnostics.
8033 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8034 c & 'Contacts ',i,j,
8035 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8036 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8038 C Calculate the multi-body contribution to energy.
8039 C ecorr=ecorr+ekont*ees
8040 C Calculate multi-body contributions to the gradient.
8041 coeffpees0pij=coeffp*ees0pij
8042 coeffmees0mij=coeffm*ees0mij
8043 coeffpees0pkl=coeffp*ees0pkl
8044 coeffmees0mkl=coeffm*ees0mkl
8046 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8047 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8048 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8049 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8050 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8051 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8052 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8053 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8054 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8055 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8056 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8057 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8058 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8059 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8060 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8061 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8062 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8063 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8064 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8065 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8066 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8067 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8068 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8069 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8070 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8075 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8076 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8077 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8078 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8083 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8084 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8085 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8086 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8089 c write (iout,*) "ehbcorr",ekont*ees
8090 C print *,ekont,ees,i,k
8092 C now gradient over shielding
8094 if (shield_mode.gt.0) then
8097 C print *,i,j,fac_shield(i),fac_shield(j),
8098 C &fac_shield(k),fac_shield(l)
8099 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
8100 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8101 do ilist=1,ishield_list(i)
8102 iresshield=shield_list(ilist,i)
8104 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8106 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8108 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8109 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8113 do ilist=1,ishield_list(j)
8114 iresshield=shield_list(ilist,j)
8116 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8118 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8120 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8121 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8126 do ilist=1,ishield_list(k)
8127 iresshield=shield_list(ilist,k)
8129 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8131 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8133 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8134 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8138 do ilist=1,ishield_list(l)
8139 iresshield=shield_list(ilist,l)
8141 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8143 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8145 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8146 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8150 C print *,gshieldx(m,iresshield)
8152 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
8153 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8154 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
8155 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8156 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
8157 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8158 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
8159 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8161 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
8162 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8163 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
8164 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8165 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
8166 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8167 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
8168 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8176 C---------------------------------------------------------------------------
8177 subroutine dipole(i,j,jj)
8178 implicit real*8 (a-h,o-z)
8179 include 'DIMENSIONS'
8180 include 'DIMENSIONS.ZSCOPT'
8181 include 'COMMON.IOUNITS'
8182 include 'COMMON.CHAIN'
8183 include 'COMMON.FFIELD'
8184 include 'COMMON.DERIV'
8185 include 'COMMON.INTERACT'
8186 include 'COMMON.CONTACTS'
8187 include 'COMMON.TORSION'
8188 include 'COMMON.VAR'
8189 include 'COMMON.GEO'
8190 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8192 iti1 = itortyp(itype(i+1))
8193 if (j.lt.nres-1) then
8194 itj1 = itype2loc(itype(j+1))
8199 dipi(iii,1)=Ub2(iii,i)
8200 dipderi(iii)=Ub2der(iii,i)
8201 dipi(iii,2)=b1(iii,i+1)
8202 dipj(iii,1)=Ub2(iii,j)
8203 dipderj(iii)=Ub2der(iii,j)
8204 dipj(iii,2)=b1(iii,j+1)
8208 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8211 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8218 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8222 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8227 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8228 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8230 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8232 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8234 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8239 C---------------------------------------------------------------------------
8240 subroutine calc_eello(i,j,k,l,jj,kk)
8242 C This subroutine computes matrices and vectors needed to calculate
8243 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8245 implicit real*8 (a-h,o-z)
8246 include 'DIMENSIONS'
8247 include 'DIMENSIONS.ZSCOPT'
8248 include 'COMMON.IOUNITS'
8249 include 'COMMON.CHAIN'
8250 include 'COMMON.DERIV'
8251 include 'COMMON.INTERACT'
8252 include 'COMMON.CONTACTS'
8253 include 'COMMON.TORSION'
8254 include 'COMMON.VAR'
8255 include 'COMMON.GEO'
8256 include 'COMMON.FFIELD'
8257 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8258 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8261 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8262 cd & ' jj=',jj,' kk=',kk
8263 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8264 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8265 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8268 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8269 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8272 call transpose2(aa1(1,1),aa1t(1,1))
8273 call transpose2(aa2(1,1),aa2t(1,1))
8276 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8277 & aa1tder(1,1,lll,kkk))
8278 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8279 & aa2tder(1,1,lll,kkk))
8283 C parallel orientation of the two CA-CA-CA frames.
8285 iti=itype2loc(itype(i))
8289 itk1=itype2loc(itype(k+1))
8290 itj=itype2loc(itype(j))
8291 if (l.lt.nres-1) then
8292 itl1=itype2loc(itype(l+1))
8296 C A1 kernel(j+1) A2T
8298 cd write (iout,'(3f10.5,5x,3f10.5)')
8299 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8301 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8302 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8303 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8304 C Following matrices are needed only for 6-th order cumulants
8305 IF (wcorr6.gt.0.0d0) THEN
8306 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8307 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8308 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8309 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8310 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8311 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8312 & ADtEAderx(1,1,1,1,1,1))
8314 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8315 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8316 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8317 & ADtEA1derx(1,1,1,1,1,1))
8319 C End 6-th order cumulants
8322 cd write (2,*) 'In calc_eello6'
8324 cd write (2,*) 'iii=',iii
8326 cd write (2,*) 'kkk=',kkk
8328 cd write (2,'(3(2f10.5),5x)')
8329 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8334 call transpose2(EUgder(1,1,k),auxmat(1,1))
8335 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8336 call transpose2(EUg(1,1,k),auxmat(1,1))
8337 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8338 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8342 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8343 & EAEAderx(1,1,lll,kkk,iii,1))
8347 C A1T kernel(i+1) A2
8348 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8349 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8350 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8351 C Following matrices are needed only for 6-th order cumulants
8352 IF (wcorr6.gt.0.0d0) THEN
8353 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8354 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8355 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8356 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8357 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8358 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8359 & ADtEAderx(1,1,1,1,1,2))
8360 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8361 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8362 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8363 & ADtEA1derx(1,1,1,1,1,2))
8365 C End 6-th order cumulants
8366 call transpose2(EUgder(1,1,l),auxmat(1,1))
8367 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8368 call transpose2(EUg(1,1,l),auxmat(1,1))
8369 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8370 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8374 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8375 & EAEAderx(1,1,lll,kkk,iii,2))
8380 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8381 C They are needed only when the fifth- or the sixth-order cumulants are
8383 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8384 call transpose2(AEA(1,1,1),auxmat(1,1))
8385 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8386 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8387 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8388 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8389 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8390 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8391 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8392 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8393 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8394 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8395 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8396 call transpose2(AEA(1,1,2),auxmat(1,1))
8397 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8398 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8399 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8400 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8401 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8402 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8403 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8404 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8405 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8406 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8407 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8408 C Calculate the Cartesian derivatives of the vectors.
8412 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8413 call matvec2(auxmat(1,1),b1(1,i),
8414 & AEAb1derx(1,lll,kkk,iii,1,1))
8415 call matvec2(auxmat(1,1),Ub2(1,i),
8416 & AEAb2derx(1,lll,kkk,iii,1,1))
8417 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8418 & AEAb1derx(1,lll,kkk,iii,2,1))
8419 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8420 & AEAb2derx(1,lll,kkk,iii,2,1))
8421 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8422 call matvec2(auxmat(1,1),b1(1,j),
8423 & AEAb1derx(1,lll,kkk,iii,1,2))
8424 call matvec2(auxmat(1,1),Ub2(1,j),
8425 & AEAb2derx(1,lll,kkk,iii,1,2))
8426 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8427 & AEAb1derx(1,lll,kkk,iii,2,2))
8428 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8429 & AEAb2derx(1,lll,kkk,iii,2,2))
8436 C Antiparallel orientation of the two CA-CA-CA frames.
8438 iti=itype2loc(itype(i))
8442 itk1=itype2loc(itype(k+1))
8443 itl=itype2loc(itype(l))
8444 itj=itype2loc(itype(j))
8445 if (j.lt.nres-1) then
8446 itj1=itype2loc(itype(j+1))
8450 C A2 kernel(j-1)T A1T
8451 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8452 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8453 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8454 C Following matrices are needed only for 6-th order cumulants
8455 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8456 & j.eq.i+4 .and. l.eq.i+3)) THEN
8457 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8458 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8459 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8460 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8461 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8462 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8463 & ADtEAderx(1,1,1,1,1,1))
8464 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8465 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8466 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8467 & ADtEA1derx(1,1,1,1,1,1))
8469 C End 6-th order cumulants
8470 call transpose2(EUgder(1,1,k),auxmat(1,1))
8471 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8472 call transpose2(EUg(1,1,k),auxmat(1,1))
8473 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8474 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8478 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8479 & EAEAderx(1,1,lll,kkk,iii,1))
8483 C A2T kernel(i+1)T A1
8484 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8485 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8486 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8487 C Following matrices are needed only for 6-th order cumulants
8488 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8489 & j.eq.i+4 .and. l.eq.i+3)) THEN
8490 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8491 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8492 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8493 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8494 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8495 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8496 & ADtEAderx(1,1,1,1,1,2))
8497 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8498 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8499 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8500 & ADtEA1derx(1,1,1,1,1,2))
8502 C End 6-th order cumulants
8503 call transpose2(EUgder(1,1,j),auxmat(1,1))
8504 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8505 call transpose2(EUg(1,1,j),auxmat(1,1))
8506 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8507 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8511 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8512 & EAEAderx(1,1,lll,kkk,iii,2))
8517 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8518 C They are needed only when the fifth- or the sixth-order cumulants are
8520 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8521 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8522 call transpose2(AEA(1,1,1),auxmat(1,1))
8523 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8524 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8525 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8526 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8527 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8528 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8529 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8530 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8531 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8532 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8533 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8534 call transpose2(AEA(1,1,2),auxmat(1,1))
8535 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8536 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8537 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8538 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8539 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8540 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8541 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8542 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8543 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8544 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8545 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8546 C Calculate the Cartesian derivatives of the vectors.
8550 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8551 call matvec2(auxmat(1,1),b1(1,i),
8552 & AEAb1derx(1,lll,kkk,iii,1,1))
8553 call matvec2(auxmat(1,1),Ub2(1,i),
8554 & AEAb2derx(1,lll,kkk,iii,1,1))
8555 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8556 & AEAb1derx(1,lll,kkk,iii,2,1))
8557 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8558 & AEAb2derx(1,lll,kkk,iii,2,1))
8559 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8560 call matvec2(auxmat(1,1),b1(1,l),
8561 & AEAb1derx(1,lll,kkk,iii,1,2))
8562 call matvec2(auxmat(1,1),Ub2(1,l),
8563 & AEAb2derx(1,lll,kkk,iii,1,2))
8564 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8565 & AEAb1derx(1,lll,kkk,iii,2,2))
8566 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8567 & AEAb2derx(1,lll,kkk,iii,2,2))
8576 C---------------------------------------------------------------------------
8577 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8578 & KK,KKderg,AKA,AKAderg,AKAderx)
8582 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8583 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8584 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8589 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8591 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8594 cd if (lprn) write (2,*) 'In kernel'
8596 cd if (lprn) write (2,*) 'kkk=',kkk
8598 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8599 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8601 cd write (2,*) 'lll=',lll
8602 cd write (2,*) 'iii=1'
8604 cd write (2,'(3(2f10.5),5x)')
8605 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8608 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8609 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8611 cd write (2,*) 'lll=',lll
8612 cd write (2,*) 'iii=2'
8614 cd write (2,'(3(2f10.5),5x)')
8615 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8622 C---------------------------------------------------------------------------
8623 double precision function eello4(i,j,k,l,jj,kk)
8624 implicit real*8 (a-h,o-z)
8625 include 'DIMENSIONS'
8626 include 'DIMENSIONS.ZSCOPT'
8627 include 'COMMON.IOUNITS'
8628 include 'COMMON.CHAIN'
8629 include 'COMMON.DERIV'
8630 include 'COMMON.INTERACT'
8631 include 'COMMON.CONTACTS'
8632 include 'COMMON.TORSION'
8633 include 'COMMON.VAR'
8634 include 'COMMON.GEO'
8635 double precision pizda(2,2),ggg1(3),ggg2(3)
8636 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8640 cd print *,'eello4:',i,j,k,l,jj,kk
8641 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8642 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8643 cold eij=facont_hb(jj,i)
8644 cold ekl=facont_hb(kk,k)
8646 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8648 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8649 gcorr_loc(k-1)=gcorr_loc(k-1)
8650 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8652 gcorr_loc(l-1)=gcorr_loc(l-1)
8653 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8655 gcorr_loc(j-1)=gcorr_loc(j-1)
8656 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8661 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8662 & -EAEAderx(2,2,lll,kkk,iii,1)
8663 cd derx(lll,kkk,iii)=0.0d0
8667 cd gcorr_loc(l-1)=0.0d0
8668 cd gcorr_loc(j-1)=0.0d0
8669 cd gcorr_loc(k-1)=0.0d0
8671 cd write (iout,*)'Contacts have occurred for peptide groups',
8672 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8673 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8674 if (j.lt.nres-1) then
8681 if (l.lt.nres-1) then
8689 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8690 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8691 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8692 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8693 cgrad ghalf=0.5d0*ggg1(ll)
8694 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8695 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8696 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8697 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8698 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8699 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8700 cgrad ghalf=0.5d0*ggg2(ll)
8701 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8702 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8703 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8704 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8705 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8706 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8710 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8715 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8720 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8725 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8729 cd write (2,*) iii,gcorr_loc(iii)
8733 cd write (2,*) 'ekont',ekont
8734 cd write (iout,*) 'eello4',ekont*eel4
8737 C---------------------------------------------------------------------------
8738 double precision function eello5(i,j,k,l,jj,kk)
8739 implicit real*8 (a-h,o-z)
8740 include 'DIMENSIONS'
8741 include 'DIMENSIONS.ZSCOPT'
8742 include 'COMMON.IOUNITS'
8743 include 'COMMON.CHAIN'
8744 include 'COMMON.DERIV'
8745 include 'COMMON.INTERACT'
8746 include 'COMMON.CONTACTS'
8747 include 'COMMON.TORSION'
8748 include 'COMMON.VAR'
8749 include 'COMMON.GEO'
8750 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8751 double precision ggg1(3),ggg2(3)
8752 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8757 C /l\ / \ \ / \ / \ / C
8758 C / \ / \ \ / \ / \ / C
8759 C j| o |l1 | o | o| o | | o |o C
8760 C \ |/k\| |/ \| / |/ \| |/ \| C
8761 C \i/ \ / \ / / \ / \ C
8763 C (I) (II) (III) (IV) C
8765 C eello5_1 eello5_2 eello5_3 eello5_4 C
8767 C Antiparallel chains C
8770 C /j\ / \ \ / \ / \ / C
8771 C / \ / \ \ / \ / \ / C
8772 C j1| o |l | o | o| o | | o |o C
8773 C \ |/k\| |/ \| / |/ \| |/ \| C
8774 C \i/ \ / \ / / \ / \ C
8776 C (I) (II) (III) (IV) C
8778 C eello5_1 eello5_2 eello5_3 eello5_4 C
8780 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8782 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8783 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8788 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8790 itk=itype2loc(itype(k))
8791 itl=itype2loc(itype(l))
8792 itj=itype2loc(itype(j))
8797 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8798 cd & eel5_3_num,eel5_4_num)
8802 derx(lll,kkk,iii)=0.0d0
8806 cd eij=facont_hb(jj,i)
8807 cd ekl=facont_hb(kk,k)
8809 cd write (iout,*)'Contacts have occurred for peptide groups',
8810 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8812 C Contribution from the graph I.
8813 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8814 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8815 call transpose2(EUg(1,1,k),auxmat(1,1))
8816 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8817 vv(1)=pizda(1,1)-pizda(2,2)
8818 vv(2)=pizda(1,2)+pizda(2,1)
8819 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8820 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8822 C Explicit gradient in virtual-dihedral angles.
8823 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8824 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8825 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8826 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8827 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8828 vv(1)=pizda(1,1)-pizda(2,2)
8829 vv(2)=pizda(1,2)+pizda(2,1)
8830 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8831 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8832 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8833 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8834 vv(1)=pizda(1,1)-pizda(2,2)
8835 vv(2)=pizda(1,2)+pizda(2,1)
8837 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8838 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8839 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8841 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8842 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8843 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8845 C Cartesian gradient
8849 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8851 vv(1)=pizda(1,1)-pizda(2,2)
8852 vv(2)=pizda(1,2)+pizda(2,1)
8853 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8854 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8855 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8862 C Contribution from graph II
8863 call transpose2(EE(1,1,k),auxmat(1,1))
8864 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8865 vv(1)=pizda(1,1)+pizda(2,2)
8866 vv(2)=pizda(2,1)-pizda(1,2)
8867 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8868 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8870 C Explicit gradient in virtual-dihedral angles.
8871 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8872 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8873 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8874 vv(1)=pizda(1,1)+pizda(2,2)
8875 vv(2)=pizda(2,1)-pizda(1,2)
8877 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8878 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8879 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8881 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8882 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8883 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8885 C Cartesian gradient
8889 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8891 vv(1)=pizda(1,1)+pizda(2,2)
8892 vv(2)=pizda(2,1)-pizda(1,2)
8893 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8894 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8895 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8904 C Parallel orientation
8905 C Contribution from graph III
8906 call transpose2(EUg(1,1,l),auxmat(1,1))
8907 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8908 vv(1)=pizda(1,1)-pizda(2,2)
8909 vv(2)=pizda(1,2)+pizda(2,1)
8910 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8911 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8913 C Explicit gradient in virtual-dihedral angles.
8914 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8915 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8916 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8917 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8918 vv(1)=pizda(1,1)-pizda(2,2)
8919 vv(2)=pizda(1,2)+pizda(2,1)
8920 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8921 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8922 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8923 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8924 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8925 vv(1)=pizda(1,1)-pizda(2,2)
8926 vv(2)=pizda(1,2)+pizda(2,1)
8927 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8928 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8929 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8930 C Cartesian gradient
8934 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8936 vv(1)=pizda(1,1)-pizda(2,2)
8937 vv(2)=pizda(1,2)+pizda(2,1)
8938 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8939 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8940 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8945 C Contribution from graph IV
8947 call transpose2(EE(1,1,l),auxmat(1,1))
8948 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8949 vv(1)=pizda(1,1)+pizda(2,2)
8950 vv(2)=pizda(2,1)-pizda(1,2)
8951 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8952 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8953 C Explicit gradient in virtual-dihedral angles.
8954 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8955 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8956 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8957 vv(1)=pizda(1,1)+pizda(2,2)
8958 vv(2)=pizda(2,1)-pizda(1,2)
8959 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8960 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8961 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8962 C Cartesian gradient
8966 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8968 vv(1)=pizda(1,1)+pizda(2,2)
8969 vv(2)=pizda(2,1)-pizda(1,2)
8970 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8971 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8972 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8978 C Antiparallel orientation
8979 C Contribution from graph III
8981 call transpose2(EUg(1,1,j),auxmat(1,1))
8982 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8983 vv(1)=pizda(1,1)-pizda(2,2)
8984 vv(2)=pizda(1,2)+pizda(2,1)
8985 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8986 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8988 C Explicit gradient in virtual-dihedral angles.
8989 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8990 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8991 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8992 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8993 vv(1)=pizda(1,1)-pizda(2,2)
8994 vv(2)=pizda(1,2)+pizda(2,1)
8995 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8996 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8997 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8998 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8999 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9000 vv(1)=pizda(1,1)-pizda(2,2)
9001 vv(2)=pizda(1,2)+pizda(2,1)
9002 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9003 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9004 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9005 C Cartesian gradient
9009 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9011 vv(1)=pizda(1,1)-pizda(2,2)
9012 vv(2)=pizda(1,2)+pizda(2,1)
9013 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9014 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9015 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9021 C Contribution from graph IV
9023 call transpose2(EE(1,1,j),auxmat(1,1))
9024 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9025 vv(1)=pizda(1,1)+pizda(2,2)
9026 vv(2)=pizda(2,1)-pizda(1,2)
9027 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9028 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9030 C Explicit gradient in virtual-dihedral angles.
9031 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9032 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9033 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9034 vv(1)=pizda(1,1)+pizda(2,2)
9035 vv(2)=pizda(2,1)-pizda(1,2)
9036 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9037 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9038 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9039 C Cartesian gradient
9043 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9045 vv(1)=pizda(1,1)+pizda(2,2)
9046 vv(2)=pizda(2,1)-pizda(1,2)
9047 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9048 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9049 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9056 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9057 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9058 cd write (2,*) 'ijkl',i,j,k,l
9059 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9060 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9062 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9063 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9064 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9065 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9067 if (j.lt.nres-1) then
9074 if (l.lt.nres-1) then
9084 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9085 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9086 C summed up outside the subrouine as for the other subroutines
9087 C handling long-range interactions. The old code is commented out
9088 C with "cgrad" to keep track of changes.
9090 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9091 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9092 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9093 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9094 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9095 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9096 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9097 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9098 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9099 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9101 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9102 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9103 cgrad ghalf=0.5d0*ggg1(ll)
9105 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9106 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9107 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9108 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9109 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9110 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9111 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9112 cgrad ghalf=0.5d0*ggg2(ll)
9114 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9115 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9116 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9117 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9118 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9119 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9125 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9126 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9131 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9132 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9138 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9143 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9147 cd write (2,*) iii,g_corr5_loc(iii)
9150 cd write (2,*) 'ekont',ekont
9151 cd write (iout,*) 'eello5',ekont*eel5
9154 c--------------------------------------------------------------------------
9155 double precision function eello6(i,j,k,l,jj,kk)
9156 implicit real*8 (a-h,o-z)
9157 include 'DIMENSIONS'
9158 include 'DIMENSIONS.ZSCOPT'
9159 include 'COMMON.IOUNITS'
9160 include 'COMMON.CHAIN'
9161 include 'COMMON.DERIV'
9162 include 'COMMON.INTERACT'
9163 include 'COMMON.CONTACTS'
9164 include 'COMMON.TORSION'
9165 include 'COMMON.VAR'
9166 include 'COMMON.GEO'
9167 include 'COMMON.FFIELD'
9168 double precision ggg1(3),ggg2(3)
9169 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9174 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9182 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9183 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9187 derx(lll,kkk,iii)=0.0d0
9191 cd eij=facont_hb(jj,i)
9192 cd ekl=facont_hb(kk,k)
9198 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9199 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9200 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9201 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9202 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9203 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9205 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9206 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9207 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9208 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9209 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9210 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9214 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9216 C If turn contributions are considered, they will be handled separately.
9217 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9218 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9219 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9220 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9221 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9222 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9223 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9226 if (j.lt.nres-1) then
9233 if (l.lt.nres-1) then
9241 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9242 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9243 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9244 cgrad ghalf=0.5d0*ggg1(ll)
9246 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9247 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9248 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9249 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9250 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9251 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9252 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9253 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9254 cgrad ghalf=0.5d0*ggg2(ll)
9255 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9257 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9258 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9259 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9260 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9261 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9262 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9268 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9269 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9274 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9275 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9281 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9286 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9290 cd write (2,*) iii,g_corr6_loc(iii)
9293 cd write (2,*) 'ekont',ekont
9294 cd write (iout,*) 'eello6',ekont*eel6
9297 c--------------------------------------------------------------------------
9298 double precision function eello6_graph1(i,j,k,l,imat,swap)
9299 implicit real*8 (a-h,o-z)
9300 include 'DIMENSIONS'
9301 include 'DIMENSIONS.ZSCOPT'
9302 include 'COMMON.IOUNITS'
9303 include 'COMMON.CHAIN'
9304 include 'COMMON.DERIV'
9305 include 'COMMON.INTERACT'
9306 include 'COMMON.CONTACTS'
9307 include 'COMMON.TORSION'
9308 include 'COMMON.VAR'
9309 include 'COMMON.GEO'
9310 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9314 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9316 C Parallel Antiparallel C
9322 C \ j|/k\| / \ |/k\|l / C
9327 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9328 itk=itype2loc(itype(k))
9329 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9330 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9331 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9332 call transpose2(EUgC(1,1,k),auxmat(1,1))
9333 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9334 vv1(1)=pizda1(1,1)-pizda1(2,2)
9335 vv1(2)=pizda1(1,2)+pizda1(2,1)
9336 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9337 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9338 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9339 s5=scalar2(vv(1),Dtobr2(1,i))
9340 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9341 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9343 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9344 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9345 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9346 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9347 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9348 & +scalar2(vv(1),Dtobr2der(1,i)))
9349 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9350 vv1(1)=pizda1(1,1)-pizda1(2,2)
9351 vv1(2)=pizda1(1,2)+pizda1(2,1)
9352 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9353 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9355 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9356 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9357 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9358 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9359 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9361 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9362 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9363 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9364 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9365 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9367 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9368 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9369 vv1(1)=pizda1(1,1)-pizda1(2,2)
9370 vv1(2)=pizda1(1,2)+pizda1(2,1)
9371 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9372 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9373 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9374 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9383 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9384 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9385 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9386 call transpose2(EUgC(1,1,k),auxmat(1,1))
9387 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9389 vv1(1)=pizda1(1,1)-pizda1(2,2)
9390 vv1(2)=pizda1(1,2)+pizda1(2,1)
9391 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9392 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9393 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9394 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9395 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9396 s5=scalar2(vv(1),Dtobr2(1,i))
9397 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9404 c----------------------------------------------------------------------------
9405 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9406 implicit real*8 (a-h,o-z)
9407 include 'DIMENSIONS'
9408 include 'DIMENSIONS.ZSCOPT'
9409 include 'COMMON.IOUNITS'
9410 include 'COMMON.CHAIN'
9411 include 'COMMON.DERIV'
9412 include 'COMMON.INTERACT'
9413 include 'COMMON.CONTACTS'
9414 include 'COMMON.TORSION'
9415 include 'COMMON.VAR'
9416 include 'COMMON.GEO'
9418 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9419 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9422 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9424 C Parallel Antiparallel C
9430 C \ j|/k\| \ |/k\|l C
9435 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9436 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9437 C AL 7/4/01 s1 would occur in the sixth-order moment,
9438 C but not in a cluster cumulant
9440 s1=dip(1,jj,i)*dip(1,kk,k)
9442 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9443 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9444 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9445 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9446 call transpose2(EUg(1,1,k),auxmat(1,1))
9447 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9448 vv(1)=pizda(1,1)-pizda(2,2)
9449 vv(2)=pizda(1,2)+pizda(2,1)
9450 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9451 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9453 eello6_graph2=-(s1+s2+s3+s4)
9455 eello6_graph2=-(s2+s3+s4)
9458 C Derivatives in gamma(i-1)
9462 s1=dipderg(1,jj,i)*dip(1,kk,k)
9464 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9465 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9466 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9467 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9469 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9471 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9473 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9475 C Derivatives in gamma(k-1)
9477 s1=dip(1,jj,i)*dipderg(1,kk,k)
9479 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9480 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9481 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9482 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9483 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9484 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9485 vv(1)=pizda(1,1)-pizda(2,2)
9486 vv(2)=pizda(1,2)+pizda(2,1)
9487 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9489 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9491 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9493 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9494 C Derivatives in gamma(j-1) or gamma(l-1)
9497 s1=dipderg(3,jj,i)*dip(1,kk,k)
9499 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9500 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9501 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9502 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9503 vv(1)=pizda(1,1)-pizda(2,2)
9504 vv(2)=pizda(1,2)+pizda(2,1)
9505 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9508 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9510 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9513 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9514 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9516 C Derivatives in gamma(l-1) or gamma(j-1)
9519 s1=dip(1,jj,i)*dipderg(3,kk,k)
9521 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9522 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9523 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9524 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9525 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9526 vv(1)=pizda(1,1)-pizda(2,2)
9527 vv(2)=pizda(1,2)+pizda(2,1)
9528 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9531 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9533 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9536 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9537 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9539 C Cartesian derivatives.
9541 write (2,*) 'In eello6_graph2'
9543 write (2,*) 'iii=',iii
9545 write (2,*) 'kkk=',kkk
9547 write (2,'(3(2f10.5),5x)')
9548 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9558 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9560 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9563 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9565 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9566 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9568 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9569 call transpose2(EUg(1,1,k),auxmat(1,1))
9570 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9572 vv(1)=pizda(1,1)-pizda(2,2)
9573 vv(2)=pizda(1,2)+pizda(2,1)
9574 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9575 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9577 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9579 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9582 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9584 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9592 c----------------------------------------------------------------------------
9593 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9594 implicit real*8 (a-h,o-z)
9595 include 'DIMENSIONS'
9596 include 'DIMENSIONS.ZSCOPT'
9597 include 'COMMON.IOUNITS'
9598 include 'COMMON.CHAIN'
9599 include 'COMMON.DERIV'
9600 include 'COMMON.INTERACT'
9601 include 'COMMON.CONTACTS'
9602 include 'COMMON.TORSION'
9603 include 'COMMON.VAR'
9604 include 'COMMON.GEO'
9605 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9607 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9609 C Parallel Antiparallel C
9615 C j|/k\| / |/k\|l / C
9620 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9622 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9623 C energy moment and not to the cluster cumulant.
9624 iti=itortyp(itype(i))
9625 if (j.lt.nres-1) then
9626 itj1=itype2loc(itype(j+1))
9630 itk=itype2loc(itype(k))
9631 itk1=itype2loc(itype(k+1))
9632 if (l.lt.nres-1) then
9633 itl1=itype2loc(itype(l+1))
9638 s1=dip(4,jj,i)*dip(4,kk,k)
9640 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9641 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9642 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9643 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9644 call transpose2(EE(1,1,k),auxmat(1,1))
9645 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9646 vv(1)=pizda(1,1)+pizda(2,2)
9647 vv(2)=pizda(2,1)-pizda(1,2)
9648 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9649 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9650 cd & "sum",-(s2+s3+s4)
9652 eello6_graph3=-(s1+s2+s3+s4)
9654 eello6_graph3=-(s2+s3+s4)
9657 C Derivatives in gamma(k-1)
9659 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9660 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9661 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9662 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9663 C Derivatives in gamma(l-1)
9664 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9665 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9666 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9667 vv(1)=pizda(1,1)+pizda(2,2)
9668 vv(2)=pizda(2,1)-pizda(1,2)
9669 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9670 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9671 C Cartesian derivatives.
9677 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9679 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9682 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9684 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9685 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9687 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9688 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9690 vv(1)=pizda(1,1)+pizda(2,2)
9691 vv(2)=pizda(2,1)-pizda(1,2)
9692 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9694 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9696 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9699 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9701 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9703 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9710 c----------------------------------------------------------------------------
9711 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9712 implicit real*8 (a-h,o-z)
9713 include 'DIMENSIONS'
9714 include 'DIMENSIONS.ZSCOPT'
9715 include 'COMMON.IOUNITS'
9716 include 'COMMON.CHAIN'
9717 include 'COMMON.DERIV'
9718 include 'COMMON.INTERACT'
9719 include 'COMMON.CONTACTS'
9720 include 'COMMON.TORSION'
9721 include 'COMMON.VAR'
9722 include 'COMMON.GEO'
9723 include 'COMMON.FFIELD'
9724 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9725 & auxvec1(2),auxmat1(2,2)
9727 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9729 C Parallel Antiparallel C
9735 C \ j|/k\| \ |/k\|l C
9740 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9742 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9743 C energy moment and not to the cluster cumulant.
9744 cd write (2,*) 'eello_graph4: wturn6',wturn6
9745 iti=itype2loc(itype(i))
9746 itj=itype2loc(itype(j))
9747 if (j.lt.nres-1) then
9748 itj1=itype2loc(itype(j+1))
9752 itk=itype2loc(itype(k))
9753 if (k.lt.nres-1) then
9754 itk1=itype2loc(itype(k+1))
9758 itl=itype2loc(itype(l))
9759 if (l.lt.nres-1) then
9760 itl1=itype2loc(itype(l+1))
9764 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9765 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9766 cd & ' itl',itl,' itl1',itl1
9769 s1=dip(3,jj,i)*dip(3,kk,k)
9771 s1=dip(2,jj,j)*dip(2,kk,l)
9774 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9775 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9777 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9778 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9780 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9781 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9783 call transpose2(EUg(1,1,k),auxmat(1,1))
9784 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9785 vv(1)=pizda(1,1)-pizda(2,2)
9786 vv(2)=pizda(2,1)+pizda(1,2)
9787 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9788 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9790 eello6_graph4=-(s1+s2+s3+s4)
9792 eello6_graph4=-(s2+s3+s4)
9794 C Derivatives in gamma(i-1)
9799 s1=dipderg(2,jj,i)*dip(3,kk,k)
9801 s1=dipderg(4,jj,j)*dip(2,kk,l)
9804 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9806 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9807 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9809 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9810 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9812 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9813 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9814 cd write (2,*) 'turn6 derivatives'
9816 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9818 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9822 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9824 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9828 C Derivatives in gamma(k-1)
9831 s1=dip(3,jj,i)*dipderg(2,kk,k)
9833 s1=dip(2,jj,j)*dipderg(4,kk,l)
9836 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9837 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9839 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9840 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9842 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9843 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9845 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9846 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9847 vv(1)=pizda(1,1)-pizda(2,2)
9848 vv(2)=pizda(2,1)+pizda(1,2)
9849 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9850 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9852 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9854 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9858 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9860 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9863 C Derivatives in gamma(j-1) or gamma(l-1)
9864 if (l.eq.j+1 .and. l.gt.1) then
9865 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9866 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9867 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9868 vv(1)=pizda(1,1)-pizda(2,2)
9869 vv(2)=pizda(2,1)+pizda(1,2)
9870 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9871 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9872 else if (j.gt.1) then
9873 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9874 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9875 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9876 vv(1)=pizda(1,1)-pizda(2,2)
9877 vv(2)=pizda(2,1)+pizda(1,2)
9878 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9879 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9880 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9882 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9885 C Cartesian derivatives.
9892 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9894 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9898 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9900 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9904 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9906 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9908 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9909 & b1(1,j+1),auxvec(1))
9910 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9912 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9913 & b1(1,l+1),auxvec(1))
9914 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9916 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9918 vv(1)=pizda(1,1)-pizda(2,2)
9919 vv(2)=pizda(2,1)+pizda(1,2)
9920 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9922 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9924 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9927 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9930 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9933 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9935 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9937 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9941 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9943 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9946 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9948 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9957 c----------------------------------------------------------------------------
9958 double precision function eello_turn6(i,jj,kk)
9959 implicit real*8 (a-h,o-z)
9960 include 'DIMENSIONS'
9961 include 'DIMENSIONS.ZSCOPT'
9962 include 'COMMON.IOUNITS'
9963 include 'COMMON.CHAIN'
9964 include 'COMMON.DERIV'
9965 include 'COMMON.INTERACT'
9966 include 'COMMON.CONTACTS'
9967 include 'COMMON.TORSION'
9968 include 'COMMON.VAR'
9969 include 'COMMON.GEO'
9970 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9971 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9973 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9974 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9975 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9976 C the respective energy moment and not to the cluster cumulant.
9985 iti=itype2loc(itype(i))
9986 itk=itype2loc(itype(k))
9987 itk1=itype2loc(itype(k+1))
9988 itl=itype2loc(itype(l))
9989 itj=itype2loc(itype(j))
9990 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9991 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9992 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9997 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9999 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10003 derx_turn(lll,kkk,iii)=0.0d0
10010 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10012 cd write (2,*) 'eello6_5',eello6_5
10014 call transpose2(AEA(1,1,1),auxmat(1,1))
10015 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10016 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10017 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10019 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10020 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10021 s2 = scalar2(b1(1,k),vtemp1(1))
10023 call transpose2(AEA(1,1,2),atemp(1,1))
10024 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10025 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
10026 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
10028 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10029 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10030 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10032 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10033 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10034 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10035 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10036 ss13 = scalar2(b1(1,k),vtemp4(1))
10037 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10039 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10045 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10046 C Derivatives in gamma(i+2)
10047 if (calc_grad) then
10051 call transpose2(AEA(1,1,1),auxmatd(1,1))
10052 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10053 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10054 call transpose2(AEAderg(1,1,2),atempd(1,1))
10055 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10056 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
10058 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10059 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10060 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10066 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10067 C Derivatives in gamma(i+3)
10069 call transpose2(AEA(1,1,1),auxmatd(1,1))
10070 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10071 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10072 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10074 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10075 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10076 s2d = scalar2(b1(1,k),vtemp1d(1))
10078 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
10079 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
10081 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10083 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10084 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10085 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10093 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10094 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10096 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10097 & -0.5d0*ekont*(s2d+s12d)
10099 C Derivatives in gamma(i+4)
10100 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10101 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10102 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10104 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10105 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10106 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10114 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10116 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10118 C Derivatives in gamma(i+5)
10120 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10121 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10122 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10124 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10125 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10126 s2d = scalar2(b1(1,k),vtemp1d(1))
10128 call transpose2(AEA(1,1,2),atempd(1,1))
10129 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10130 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
10132 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10133 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10135 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10136 ss13d = scalar2(b1(1,k),vtemp4d(1))
10137 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10145 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10146 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10148 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10149 & -0.5d0*ekont*(s2d+s12d)
10151 C Cartesian derivatives
10156 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10157 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10158 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10160 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10161 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10163 s2d = scalar2(b1(1,k),vtemp1d(1))
10165 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10166 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10167 s8d = -(atempd(1,1)+atempd(2,2))*
10168 & scalar2(cc(1,1,l),vtemp2(1))
10170 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10172 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10173 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10180 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10181 & - 0.5d0*(s1d+s2d)
10183 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10187 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10188 & - 0.5d0*(s8d+s12d)
10190 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10199 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10200 & achuj_tempd(1,1))
10201 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10202 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10203 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10204 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10205 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10207 ss13d = scalar2(b1(1,k),vtemp4d(1))
10208 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10209 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10213 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10214 cd & 16*eel_turn6_num
10216 if (j.lt.nres-1) then
10223 if (l.lt.nres-1) then
10231 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10232 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10233 cgrad ghalf=0.5d0*ggg1(ll)
10235 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10236 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10237 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10238 & +ekont*derx_turn(ll,2,1)
10239 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10240 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10241 & +ekont*derx_turn(ll,4,1)
10242 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10243 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10244 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10245 cgrad ghalf=0.5d0*ggg2(ll)
10247 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10248 & +ekont*derx_turn(ll,2,2)
10249 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10250 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10251 & +ekont*derx_turn(ll,4,2)
10252 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10253 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10254 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10259 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10264 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10270 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10275 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10279 cd write (2,*) iii,g_corr6_loc(iii)
10282 eello_turn6=ekont*eel_turn6
10283 cd write (2,*) 'ekont',ekont
10284 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10288 crc-------------------------------------------------
10289 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10290 subroutine Eliptransfer(eliptran)
10291 implicit real*8 (a-h,o-z)
10292 include 'DIMENSIONS'
10293 include 'DIMENSIONS.ZSCOPT'
10294 include 'COMMON.GEO'
10295 include 'COMMON.VAR'
10296 include 'COMMON.LOCAL'
10297 include 'COMMON.CHAIN'
10298 include 'COMMON.DERIV'
10299 include 'COMMON.INTERACT'
10300 include 'COMMON.IOUNITS'
10301 include 'COMMON.CALC'
10302 include 'COMMON.CONTROL'
10303 include 'COMMON.SPLITELE'
10304 include 'COMMON.SBRIDGE'
10305 C this is done by Adasko
10306 C print *,"wchodze"
10307 C structure of box:
10309 C--bordliptop-- buffore starts
10310 C--bufliptop--- here true lipid starts
10312 C--buflipbot--- lipid ends buffore starts
10313 C--bordlipbot--buffore ends
10317 if (itype(i).eq.ntyp1) cycle
10319 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10320 if (positi.le.0) positi=positi+boxzsize
10322 C first for peptide groups
10323 c for each residue check if it is in lipid or lipid water border area
10324 if ((positi.gt.bordlipbot)
10325 &.and.(positi.lt.bordliptop)) then
10326 C the energy transfer exist
10327 if (positi.lt.buflipbot) then
10328 C what fraction I am in
10330 & ((positi-bordlipbot)/lipbufthick)
10331 C lipbufthick is thickenes of lipid buffore
10332 sslip=sscalelip(fracinbuf)
10333 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10334 eliptran=eliptran+sslip*pepliptran
10335 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10336 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10337 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10338 elseif (positi.gt.bufliptop) then
10339 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10340 sslip=sscalelip(fracinbuf)
10341 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10342 eliptran=eliptran+sslip*pepliptran
10343 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10344 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10345 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10346 C print *, "doing sscalefor top part"
10347 C print *,i,sslip,fracinbuf,ssgradlip
10349 eliptran=eliptran+pepliptran
10350 C print *,"I am in true lipid"
10353 C eliptran=elpitran+0.0 ! I am in water
10356 C print *, "nic nie bylo w lipidzie?"
10357 C now multiply all by the peptide group transfer factor
10358 C eliptran=eliptran*pepliptran
10359 C now the same for side chains
10362 if (itype(i).eq.ntyp1) cycle
10363 positi=(mod(c(3,i+nres),boxzsize))
10364 if (positi.le.0) positi=positi+boxzsize
10365 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10366 c for each residue check if it is in lipid or lipid water border area
10367 C respos=mod(c(3,i+nres),boxzsize)
10368 C print *,positi,bordlipbot,buflipbot
10369 if ((positi.gt.bordlipbot)
10370 & .and.(positi.lt.bordliptop)) then
10371 C the energy transfer exist
10372 if (positi.lt.buflipbot) then
10374 & ((positi-bordlipbot)/lipbufthick)
10375 C lipbufthick is thickenes of lipid buffore
10376 sslip=sscalelip(fracinbuf)
10377 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10378 eliptran=eliptran+sslip*liptranene(itype(i))
10379 gliptranx(3,i)=gliptranx(3,i)
10380 &+ssgradlip*liptranene(itype(i))
10381 gliptranc(3,i-1)= gliptranc(3,i-1)
10382 &+ssgradlip*liptranene(itype(i))
10383 C print *,"doing sccale for lower part"
10384 elseif (positi.gt.bufliptop) then
10386 &((bordliptop-positi)/lipbufthick)
10387 sslip=sscalelip(fracinbuf)
10388 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10389 eliptran=eliptran+sslip*liptranene(itype(i))
10390 gliptranx(3,i)=gliptranx(3,i)
10391 &+ssgradlip*liptranene(itype(i))
10392 gliptranc(3,i-1)= gliptranc(3,i-1)
10393 &+ssgradlip*liptranene(itype(i))
10394 C print *, "doing sscalefor top part",sslip,fracinbuf
10396 eliptran=eliptran+liptranene(itype(i))
10397 C print *,"I am in true lipid"
10399 endif ! if in lipid or buffor
10401 C eliptran=elpitran+0.0 ! I am in water
10407 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10409 SUBROUTINE MATVEC2(A1,V1,V2)
10410 implicit real*8 (a-h,o-z)
10411 include 'DIMENSIONS'
10412 DIMENSION A1(2,2),V1(2),V2(2)
10416 c 3 VI=VI+A1(I,K)*V1(K)
10420 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10421 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10426 C---------------------------------------
10427 SUBROUTINE MATMAT2(A1,A2,A3)
10428 implicit real*8 (a-h,o-z)
10429 include 'DIMENSIONS'
10430 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10431 c DIMENSION AI3(2,2)
10435 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10441 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10442 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10443 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10444 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10452 c-------------------------------------------------------------------------
10453 double precision function scalar2(u,v)
10455 double precision u(2),v(2)
10456 double precision sc
10458 scalar2=u(1)*v(1)+u(2)*v(2)
10462 C-----------------------------------------------------------------------------
10464 subroutine transpose2(a,at)
10466 double precision a(2,2),at(2,2)
10473 c--------------------------------------------------------------------------
10474 subroutine transpose(n,a,at)
10477 double precision a(n,n),at(n,n)
10485 C---------------------------------------------------------------------------
10486 subroutine prodmat3(a1,a2,kk,transp,prod)
10489 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10491 crc double precision auxmat(2,2),prod_(2,2)
10494 crc call transpose2(kk(1,1),auxmat(1,1))
10495 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10496 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10498 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10499 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10500 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10501 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10502 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10503 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10504 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10505 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10508 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10509 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10511 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10512 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10513 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10514 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10515 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10516 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10517 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10518 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10521 c call transpose2(a2(1,1),a2t(1,1))
10524 crc print *,((prod_(i,j),i=1,2),j=1,2)
10525 crc print *,((prod(i,j),i=1,2),j=1,2)
10529 C-----------------------------------------------------------------------------
10530 double precision function scalar(u,v)
10532 double precision u(3),v(3)
10533 double precision sc
10542 C-----------------------------------------------------------------------
10543 double precision function sscale(r)
10544 double precision r,gamm
10545 include "COMMON.SPLITELE"
10546 if(r.lt.r_cut-rlamb) then
10548 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10549 gamm=(r-(r_cut-rlamb))/rlamb
10550 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10556 C-----------------------------------------------------------------------
10557 C-----------------------------------------------------------------------
10558 double precision function sscagrad(r)
10559 double precision r,gamm
10560 include "COMMON.SPLITELE"
10561 if(r.lt.r_cut-rlamb) then
10563 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10564 gamm=(r-(r_cut-rlamb))/rlamb
10565 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
10571 C-----------------------------------------------------------------------
10572 C-----------------------------------------------------------------------
10573 double precision function sscalelip(r)
10574 double precision r,gamm
10575 include "COMMON.SPLITELE"
10576 C if(r.lt.r_cut-rlamb) then
10578 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10579 C gamm=(r-(r_cut-rlamb))/rlamb
10580 sscalelip=1.0d0+r*r*(2*r-3.0d0)
10586 C-----------------------------------------------------------------------
10587 double precision function sscagradlip(r)
10588 double precision r,gamm
10589 include "COMMON.SPLITELE"
10590 C if(r.lt.r_cut-rlamb) then
10592 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10593 C gamm=(r-(r_cut-rlamb))/rlamb
10594 sscagradlip=r*(6*r-6.0d0)
10601 C-----------------------------------------------------------------------
10602 subroutine set_shield_fac
10603 implicit real*8 (a-h,o-z)
10604 include 'DIMENSIONS'
10605 include 'DIMENSIONS.ZSCOPT'
10606 include 'COMMON.CHAIN'
10607 include 'COMMON.DERIV'
10608 include 'COMMON.IOUNITS'
10609 include 'COMMON.SHIELD'
10610 include 'COMMON.INTERACT'
10611 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10612 double precision div77_81/0.974996043d0/,
10613 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10615 C the vector between center of side_chain and peptide group
10616 double precision pep_side(3),long,side_calf(3),
10617 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10618 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10619 C the line belowe needs to be changed for FGPROC>1
10621 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10623 Cif there two consequtive dummy atoms there is no peptide group between them
10624 C the line below has to be changed for FGPROC>1
10627 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10631 C first lets set vector conecting the ithe side-chain with kth side-chain
10632 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10633 C pep_side(j)=2.0d0
10634 C and vector conecting the side-chain with its proper calfa
10635 side_calf(j)=c(j,k+nres)-c(j,k)
10636 C side_calf(j)=2.0d0
10637 pept_group(j)=c(j,i)-c(j,i+1)
10638 C lets have their lenght
10639 dist_pep_side=pep_side(j)**2+dist_pep_side
10640 dist_side_calf=dist_side_calf+side_calf(j)**2
10641 dist_pept_group=dist_pept_group+pept_group(j)**2
10643 dist_pep_side=dsqrt(dist_pep_side)
10644 dist_pept_group=dsqrt(dist_pept_group)
10645 dist_side_calf=dsqrt(dist_side_calf)
10647 pep_side_norm(j)=pep_side(j)/dist_pep_side
10648 side_calf_norm(j)=dist_side_calf
10650 C now sscale fraction
10651 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10652 C print *,buff_shield,"buff"
10654 if (sh_frac_dist.le.0.0) cycle
10655 C If we reach here it means that this side chain reaches the shielding sphere
10656 C Lets add him to the list for gradient
10657 ishield_list(i)=ishield_list(i)+1
10658 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10659 C this list is essential otherwise problem would be O3
10660 shield_list(ishield_list(i),i)=k
10661 C Lets have the sscale value
10662 if (sh_frac_dist.gt.1.0) then
10663 scale_fac_dist=1.0d0
10665 sh_frac_dist_grad(j)=0.0d0
10668 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10669 & *(2.0*sh_frac_dist-3.0d0)
10670 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
10671 & /dist_pep_side/buff_shield*0.5
10672 C remember for the final gradient multiply sh_frac_dist_grad(j)
10673 C for side_chain by factor -2 !
10675 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10676 C print *,"jestem",scale_fac_dist,fac_help_scale,
10677 C & sh_frac_dist_grad(j)
10680 C if ((i.eq.3).and.(k.eq.2)) then
10681 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
10685 C this is what is now we have the distance scaling now volume...
10686 short=short_r_sidechain(itype(k))
10687 long=long_r_sidechain(itype(k))
10688 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
10691 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
10692 C costhet_fac=0.0d0
10694 costhet_grad(j)=costhet_fac*pep_side(j)
10696 C remember for the final gradient multiply costhet_grad(j)
10697 C for side_chain by factor -2 !
10698 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10699 C pep_side0pept_group is vector multiplication
10700 pep_side0pept_group=0.0
10702 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10704 cosalfa=(pep_side0pept_group/
10705 & (dist_pep_side*dist_side_calf))
10706 fac_alfa_sin=1.0-cosalfa**2
10707 fac_alfa_sin=dsqrt(fac_alfa_sin)
10708 rkprim=fac_alfa_sin*(long-short)+short
10710 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
10711 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
10714 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10715 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10716 &*(long-short)/fac_alfa_sin*cosalfa/
10717 &((dist_pep_side*dist_side_calf))*
10718 &((side_calf(j))-cosalfa*
10719 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10721 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10722 &*(long-short)/fac_alfa_sin*cosalfa
10723 &/((dist_pep_side*dist_side_calf))*
10725 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10728 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10731 C now the gradient...
10732 C grad_shield is gradient of Calfa for peptide groups
10733 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
10735 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
10736 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
10738 grad_shield(j,i)=grad_shield(j,i)
10739 C gradient po skalowaniu
10740 & +(sh_frac_dist_grad(j)
10741 C gradient po costhet
10742 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10743 &-scale_fac_dist*(cosphi_grad_long(j))
10744 &/(1.0-cosphi) )*div77_81
10746 C grad_shield_side is Cbeta sidechain gradient
10747 grad_shield_side(j,ishield_list(i),i)=
10748 & (sh_frac_dist_grad(j)*-2.0d0
10749 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10750 & +scale_fac_dist*(cosphi_grad_long(j))
10751 & *2.0d0/(1.0-cosphi))
10752 & *div77_81*VofOverlap
10754 grad_shield_loc(j,ishield_list(i),i)=
10755 & scale_fac_dist*cosphi_grad_loc(j)
10756 & *2.0d0/(1.0-cosphi)
10757 & *div77_81*VofOverlap
10759 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10761 fac_shield(i)=VolumeTotal*div77_81+div4_81
10762 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10766 C--------------------------------------------------------------------------
10767 C first for shielding is setting of function of side-chains
10768 subroutine set_shield_fac2
10769 implicit real*8 (a-h,o-z)
10770 include 'DIMENSIONS'
10771 include 'DIMENSIONS.ZSCOPT'
10772 include 'COMMON.CHAIN'
10773 include 'COMMON.DERIV'
10774 include 'COMMON.IOUNITS'
10775 include 'COMMON.SHIELD'
10776 include 'COMMON.INTERACT'
10777 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10778 double precision div77_81/0.974996043d0/,
10779 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10781 C the vector between center of side_chain and peptide group
10782 double precision pep_side(3),long,side_calf(3),
10783 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10784 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10785 C the line belowe needs to be changed for FGPROC>1
10787 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10789 Cif there two consequtive dummy atoms there is no peptide group between them
10790 C the line below has to be changed for FGPROC>1
10793 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10797 C first lets set vector conecting the ithe side-chain with kth side-chain
10798 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10799 C pep_side(j)=2.0d0
10800 C and vector conecting the side-chain with its proper calfa
10801 side_calf(j)=c(j,k+nres)-c(j,k)
10802 C side_calf(j)=2.0d0
10803 pept_group(j)=c(j,i)-c(j,i+1)
10804 C lets have their lenght
10805 dist_pep_side=pep_side(j)**2+dist_pep_side
10806 dist_side_calf=dist_side_calf+side_calf(j)**2
10807 dist_pept_group=dist_pept_group+pept_group(j)**2
10809 dist_pep_side=dsqrt(dist_pep_side)
10810 dist_pept_group=dsqrt(dist_pept_group)
10811 dist_side_calf=dsqrt(dist_side_calf)
10813 pep_side_norm(j)=pep_side(j)/dist_pep_side
10814 side_calf_norm(j)=dist_side_calf
10816 C now sscale fraction
10817 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10818 C print *,buff_shield,"buff"
10820 if (sh_frac_dist.le.0.0) cycle
10821 C If we reach here it means that this side chain reaches the shielding sphere
10822 C Lets add him to the list for gradient
10823 ishield_list(i)=ishield_list(i)+1
10824 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10825 C this list is essential otherwise problem would be O3
10826 shield_list(ishield_list(i),i)=k
10827 C Lets have the sscale value
10828 if (sh_frac_dist.gt.1.0) then
10829 scale_fac_dist=1.0d0
10831 sh_frac_dist_grad(j)=0.0d0
10834 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10835 & *(2.0d0*sh_frac_dist-3.0d0)
10836 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
10837 & /dist_pep_side/buff_shield*0.5d0
10838 C remember for the final gradient multiply sh_frac_dist_grad(j)
10839 C for side_chain by factor -2 !
10841 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10842 C sh_frac_dist_grad(j)=0.0d0
10843 C scale_fac_dist=1.0d0
10844 C print *,"jestem",scale_fac_dist,fac_help_scale,
10845 C & sh_frac_dist_grad(j)
10848 C this is what is now we have the distance scaling now volume...
10849 short=short_r_sidechain(itype(k))
10850 long=long_r_sidechain(itype(k))
10851 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
10852 sinthet=short/dist_pep_side*costhet
10856 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
10857 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
10858 C & -short/dist_pep_side**2/costhet)
10859 C costhet_fac=0.0d0
10861 costhet_grad(j)=costhet_fac*pep_side(j)
10863 C remember for the final gradient multiply costhet_grad(j)
10864 C for side_chain by factor -2 !
10865 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10866 C pep_side0pept_group is vector multiplication
10867 pep_side0pept_group=0.0d0
10869 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10871 cosalfa=(pep_side0pept_group/
10872 & (dist_pep_side*dist_side_calf))
10873 fac_alfa_sin=1.0d0-cosalfa**2
10874 fac_alfa_sin=dsqrt(fac_alfa_sin)
10875 rkprim=fac_alfa_sin*(long-short)+short
10879 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
10881 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
10882 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
10883 & dist_pep_side**2)
10886 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10887 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10888 &*(long-short)/fac_alfa_sin*cosalfa/
10889 &((dist_pep_side*dist_side_calf))*
10890 &((side_calf(j))-cosalfa*
10891 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10892 C cosphi_grad_long(j)=0.0d0
10893 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10894 &*(long-short)/fac_alfa_sin*cosalfa
10895 &/((dist_pep_side*dist_side_calf))*
10897 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10898 C cosphi_grad_loc(j)=0.0d0
10900 C print *,sinphi,sinthet
10901 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
10904 C now the gradient...
10906 grad_shield(j,i)=grad_shield(j,i)
10907 C gradient po skalowaniu
10908 & +(sh_frac_dist_grad(j)*VofOverlap
10909 C gradient po costhet
10910 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
10911 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10912 & sinphi/sinthet*costhet*costhet_grad(j)
10913 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10915 C grad_shield_side is Cbeta sidechain gradient
10916 grad_shield_side(j,ishield_list(i),i)=
10917 & (sh_frac_dist_grad(j)*-2.0d0
10919 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10920 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10921 & sinphi/sinthet*costhet*costhet_grad(j)
10922 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10925 grad_shield_loc(j,ishield_list(i),i)=
10926 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10927 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
10928 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
10932 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10934 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
10935 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10936 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
10940 C--------------------------------------------------------------------------
10941 double precision function tschebyshev(m,n,x,y)
10943 include "DIMENSIONS"
10945 double precision x(n),y,yy(0:maxvar),aux
10946 c Tschebyshev polynomial. Note that the first term is omitted
10947 c m=0: the constant term is included
10948 c m=1: the constant term is not included
10952 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
10961 C--------------------------------------------------------------------------
10962 double precision function gradtschebyshev(m,n,x,y)
10964 include "DIMENSIONS"
10966 double precision x(n+1),y,yy(0:maxvar),aux
10967 c Tschebyshev polynomial. Note that the first term is omitted
10968 c m=0: the constant term is included
10969 c m=1: the constant term is not included
10973 yy(i)=2*y*yy(i-1)-yy(i-2)
10977 aux=aux+x(i+1)*yy(i)*(i+1)
10978 C print *, x(i+1),yy(i),i
10980 gradtschebyshev=aux