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
32 goto (101,102,103,104,105,106) ipot
33 C Lennard-Jones potential.
35 cd print '(a)','Exit ELJ'
37 C Lennard-Jones-Kihara potential (shifted).
40 C Berne-Pechukas potential (dilated LJ, angular dependence).
43 C Gay-Berne potential (shifted LJ, angular dependence).
46 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
50 106 call emomo(evdw,evdw_p,evdw_m)
52 C Calculate electrostatic (H-bonding) energy of the main chain.
56 if (shield_mode.eq.1) then
58 else if (shield_mode.eq.2) then
61 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
62 C write(iout,*) 'po eelec'
64 C Calculate excluded-volume interaction energy between peptide groups
67 call escp(evdw2,evdw2_14)
69 c Calculate the bond-stretching energy
73 C write (iout,*) "estr",estr
75 C Calculate the disulfide-bridge and other energy and the contributions
76 C from other distance constraints.
77 cd print *,'Calling EHPB'
79 cd print *,'EHPB exitted succesfully.'
81 C Calculate the virtual-bond-angle energy.
83 C print *,'Bend energy finished.'
85 if (tor_mode.eq.0) then
88 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
96 if (with_theta_constr) call etheta_constr(ethetacnstr)
97 c call ebend(ebe,ethetacnstr)
98 cd print *,'Bend energy finished.'
100 C Calculate the SC local energy.
103 C print *,'SCLOC energy finished.'
105 C Calculate the virtual-bond torsional energy.
107 if (wtor.gt.0.0d0) then
108 if (tor_mode.eq.0) then
111 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
119 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
120 c print *,"Processor",myrank," computed Utor"
122 C 6/23/01 Calculate double-torsional energy
124 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
129 c print *,"Processor",myrank," computed Utord"
131 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 write (iout,*) "evdw",evdw," evdw_t",evdw_t," ees",ees,
160 & " evdw1",evdw1," ebe",ebe," etors",etors," escloc",escloc,
161 & " ehpb",ehpb," ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6,
162 & " eello_turn4",eello_turn4," eello_turn3",eello_turn3,
163 & " eturn6",eturn6," eel_loc",eel_loc," edihcnstr",edihcnstr,
164 & " etors_d",etors_d," estr",estr," esccor",esccor," ethetacnstr",
165 & ethetacnstr," eliptran",eliptran
166 write (iout,*) "wsc",wsc," welec",welec,
167 & " wvdwpp",wvdwpp," wang",wang," wtor",wtor," wscloc",wscloc,
168 & " wstrain",wstrain," wcorr",wcorr," wcorr5",wcorr5,
170 & " wturn4",wturn4," wturn3",wturn3,
171 & " wturn6",wturn6," wel_loc",wel_loc,
172 & " wtor_d",wtor_d," wbon",wbond," wsccor",wsccor,
173 & " wliptran",wliptran
176 if (shield_mode.gt.0) then
177 etot=wsc*(evdw+evdw_t)+wscp*evdw2
180 & +wang*ebe+wtor*etors+wscloc*escloc
181 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
182 & +wcorr6*ecorr6+wturn4*eello_turn4
183 & +wturn3*eello_turn3+wturn6*eturn6
184 & +wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
185 & +wbond*estr+wsccor*esccor+ethetacnstr
188 etot=wsc*(evdw+evdw_t)+wscp*evdw2+welec*ees
190 & +wang*ebe+wtor*etors+wscloc*escloc
191 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
192 & +wcorr6*ecorr6+wturn4*eello_turn4
193 & +wturn3*eello_turn3+wturn6*eturn6
194 & +wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
195 & +wbond*estr+wsccor*esccor+ethetacnstr
199 if (shield_mode.gt.0) then
200 etot=wsc*(evdw+evdw_t)+wscp*evdw2
202 & +wang*ebe+wtor*etors+wscloc*escloc
203 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
204 & +wcorr6*ecorr6+wturn4*eello_turn4
205 & +wturn3*eello_turn3+wturn6*eturn6
206 & +wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
207 & +wbond*estr+wsccor*esccor+ethetacnstr
210 etot=wsc*(evdw+evdw_t)+wscp*evdw2
212 & +wang*ebe+wtor*etors+wscloc*escloc
213 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
214 & +wcorr6*ecorr6+wturn4*eello_turn4
215 & +wturn3*eello_turn3+wturn6*eturn6
216 & +wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
217 & +wbond*estr+wsccor*esccor+ethetacnstr
222 write (iout,*) "etot",etot
227 energia(2)=evdw2-evdw2_14
244 energia(8)=eello_turn3
245 energia(9)=eello_turn4
254 energia(20)=edihcnstr
256 energia(24)=ethetacnstr
261 if (isnan(etot).ne.0) energia(0)=1.0d+99
263 if (isnan(etot)) energia(0)=1.0d+99
268 idumm=proc_proc(etot,i)
270 call proc_proc(etot,i)
272 if(i.eq.1)energia(0)=1.0d+99
278 call enerprint(energia)
282 C Sum up the components of the Cartesian gradient.
287 if (shield_mode.eq.0) then
288 gradc(j,i,icg)=wsc*gvdwc(j,i)+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 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
303 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
304 & wsccor*gsccorx(j,i)
305 & +wliptran*gliptranx(j,i)
307 gradc(j,i,icg)=wsc*gvdwc(j,i)
308 & +wscp*gvdwc_scp(j,i)+
309 & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
311 & wstrain*ghpbc(j,i)+
312 & wcorr*gradcorr(j,i)+
313 & wel_loc*gel_loc(j,i)+
314 & wturn3*gcorr3_turn(j,i)+
315 & wturn4*gcorr4_turn(j,i)+
316 & wcorr5*gradcorr5(j,i)+
317 & wcorr6*gradcorr6(j,i)+
318 & wturn6*gcorr6_turn(j,i)+
319 & wsccor*gsccorc(j,i)
320 & +wliptran*gliptranc(j,i)
321 & +welec*gshieldc(j,i)
322 & +welec*gshieldc_loc(j,i)
323 & +wcorr*gshieldc_ec(j,i)
324 & +wcorr*gshieldc_loc_ec(j,i)
325 & +wturn3*gshieldc_t3(j,i)
326 & +wturn3*gshieldc_loc_t3(j,i)
327 & +wturn4*gshieldc_t4(j,i)
328 & +wturn4*gshieldc_loc_t4(j,i)
329 & +wel_loc*gshieldc_ll(j,i)
330 & +wel_loc*gshieldc_loc_ll(j,i)
332 gradx(j,i,icg)=wsc*gvdwx(j,i)
333 & +wscp*gradx_scp(j,i)+
335 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
336 & wsccor*gsccorx(j,i)
337 & +wliptran*gliptranx(j,i)
338 & +welec*gshieldx(j,i)
339 & +wcorr*gshieldx_ec(j,i)
340 & +wturn3*gshieldx_t3(j,i)
341 & +wturn4*gshieldx_t4(j,i)
342 & +wel_loc*gshieldx_ll(j,i)
350 if (shield_mode.eq.0) then
351 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
352 & welec*gelc(j,i)+wstrain*ghpbc(j,i)+
354 & wcorr*gradcorr(j,i)+
355 & wel_loc*gel_loc(j,i)+
356 & wturn3*gcorr3_turn(j,i)+
357 & wturn4*gcorr4_turn(j,i)+
358 & wcorr5*gradcorr5(j,i)+
359 & wcorr6*gradcorr6(j,i)+
360 & wturn6*gcorr6_turn(j,i)+
361 & wsccor*gsccorc(j,i)
362 & +wliptran*gliptranc(j,i)
363 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
365 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
366 & wsccor*gsccorx(j,i)
367 & +wliptran*gliptranx(j,i)
369 gradc(j,i,icg)=wsc*gvdwc(j,i)+
370 & wscp*gvdwc_scp(j,i)+
371 & welec*gelc(j,i)+wstrain*ghpbc(j,i)+
373 & wcorr*gradcorr(j,i)+
374 & wel_loc*gel_loc(j,i)+
375 & wturn3*gcorr3_turn(j,i)+
376 & wturn4*gcorr4_turn(j,i)+
377 & wcorr5*gradcorr5(j,i)+
378 & wcorr6*gradcorr6(j,i)+
379 & wturn6*gcorr6_turn(j,i)+
380 & wsccor*gsccorc(j,i)
381 & +wliptran*gliptranc(j,i)
382 & +welec*gshieldc(j,i)
383 & +welec*gshieldc_loc(j,i)
384 & +wcorr*gshieldc_ec(j,i)
385 & +wcorr*gshieldc_loc_ec(j,i)
386 & +wturn3*gshieldc_t3(j,i)
387 & +wturn3*gshieldc_loc_t3(j,i)
388 & +wturn4*gshieldc_t4(j,i)
389 & +wturn4*gshieldc_loc_t4(j,i)
390 & +wel_loc*gshieldc_ll(j,i)
391 & +wel_loc*gshieldc_loc_ll(j,i)
393 gradx(j,i,icg)=wsc*gvdwx(j,i)+
394 & wscp*gradx_scp(j,i)+
396 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
397 & wsccor*gsccorx(j,i)
398 & +wliptran*gliptranx(j,i)
399 & +welec*gshieldx(j,i)
400 & +wcorr*gshieldx_ec(j,i)
401 & +wturn3*gshieldx_t3(j,i)
402 & +wturn4*gshieldx_t4(j,i)
403 & +wel_loc*gshieldx_ll(j,i)
412 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
413 & +wcorr5*g_corr5_loc(i)
414 & +wcorr6*g_corr6_loc(i)
415 & +wturn4*gel_loc_turn4(i)
416 & +wturn3*gel_loc_turn3(i)
417 & +wturn6*gel_loc_turn6(i)
418 & +wel_loc*gel_loc_loc(i)
419 c & +wsccor*gsccor_loc(i)
420 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
423 c if (dyn_ss) call dyn_set_nss
426 C------------------------------------------------------------------------
427 subroutine enerprint(energia)
428 implicit real*8 (a-h,o-z)
430 include 'DIMENSIONS.ZSCOPT'
431 include 'COMMON.IOUNITS'
432 include 'COMMON.FFIELD'
433 include 'COMMON.SBRIDGE'
434 double precision energia(0:max_ene)
436 evdw=energia(1)+energia(21)
438 evdw2=energia(2)+energia(17)
450 eello_turn3=energia(8)
451 eello_turn4=energia(9)
452 eello_turn6=energia(10)
459 edihcnstr=energia(20)
461 ethetacnstr=energia(24)
464 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,
466 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor,
467 & etors_d,wtor_d,ehpb,wstrain,
468 & ecorr,wcorr,ecorr5,wcorr5,ecorr6,wcorr6,
469 & eel_loc,wel_loc,eello_turn3,wturn3,
470 & eello_turn4,wturn4,eello_turn6,wturn6,
471 & esccor,wsccor,edihcnstr,ethetacnstr,ebr*nss,
472 & eliptran,wliptran,etot
473 10 format (/'Virtual-chain energies:'//
474 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
475 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
476 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
477 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
478 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
479 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
480 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
481 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
482 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
483 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
484 & ' (SS bridges & dist. cnstr.)'/
485 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
486 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
487 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
488 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
489 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
490 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
491 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
492 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
493 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
494 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
495 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
496 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
497 & 'ETOT= ',1pE16.6,' (total)')
499 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,estr,wbond,
500 & ebe,wang,escloc,wscloc,etors,wtor,etors_d,wtor_d,
501 & ehpb,wstrain,ecorr,wcorr,ecorr5,wcorr5,
502 & ecorr6,wcorr6,eel_loc,wel_loc,
503 & eello_turn3,wturn3,eello_turn4,wturn4,
504 & eello_turn6,wturn6,esccor,wsccor,
505 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot
506 10 format (/'Virtual-chain energies:'//
507 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
508 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
509 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
510 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
511 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
512 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
513 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
514 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
515 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
516 & ' (SS bridges & dist. cnstr.)'/
517 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
518 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
519 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
520 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
521 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
522 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
523 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
524 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
525 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
526 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
527 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
528 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
529 & 'ETOT= ',1pE16.6,' (total)')
533 C-----------------------------------------------------------------------
536 C This subroutine calculates the interaction energy of nonbonded side chains
537 C assuming the LJ potential of interaction.
539 implicit real*8 (a-h,o-z)
541 include 'DIMENSIONS.ZSCOPT'
542 parameter (accur=1.0d-10)
545 include 'COMMON.LOCAL'
546 include 'COMMON.CHAIN'
547 include 'COMMON.DERIV'
548 include 'COMMON.INTERACT'
549 include 'COMMON.TORSION'
550 include 'COMMON.WEIGHTDER'
551 include 'COMMON.SBRIDGE'
552 include 'COMMON.NAMES'
553 include 'COMMON.IOUNITS'
554 include 'COMMON.CONTACTS'
558 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
561 eneps_temp(j,i)=0.0d0
574 C Calculate SC interaction energy.
577 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
578 cd & 'iend=',iend(i,iint)
579 do j=istart(i,iint),iend(i,iint)
584 C Change 12/1/95 to calculate four-body interactions
585 rij=xj*xj+yj*yj+zj*zj
587 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
588 eps0ij=eps(itypi,itypj)
590 e1=fac*fac*aa(itypi,itypj)
591 e2=fac*bb(itypi,itypj)
593 ij=icant(itypi,itypj)
594 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
595 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
596 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
597 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
598 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
599 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
600 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
601 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
605 C Calculate the components of the gradient in DC and X
607 fac=-rrij*(e1+evdwij)
612 gvdwx(k,i)=gvdwx(k,i)-gg(k)
613 gvdwx(k,j)=gvdwx(k,j)+gg(k)
617 gvdwc(l,k)=gvdwc(l,k)+gg(l)
622 C 12/1/95, revised on 5/20/97
624 C Calculate the contact function. The ith column of the array JCONT will
625 C contain the numbers of atoms that make contacts with the atom I (of numbers
626 C greater than I). The arrays FACONT and GACONT will contain the values of
627 C the contact function and its derivative.
629 C Uncomment next line, if the correlation interactions include EVDW explicitly.
630 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
631 C Uncomment next line, if the correlation interactions are contact function only
632 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
634 sigij=sigma(itypi,itypj)
635 r0ij=rs0(itypi,itypj)
637 C Check whether the SC's are not too far to make a contact.
640 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
641 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
643 if (fcont.gt.0.0D0) then
644 C If the SC-SC distance if close to sigma, apply spline.
645 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
646 cAdam & fcont1,fprimcont1)
647 cAdam fcont1=1.0d0-fcont1
648 cAdam if (fcont1.gt.0.0d0) then
649 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
650 cAdam fcont=fcont*fcont1
652 C Uncomment following 4 lines to have the geometric average of the epsilon0's
653 cga eps0ij=1.0d0/dsqrt(eps0ij)
655 cga gg(k)=gg(k)*eps0ij
657 cga eps0ij=-evdwij*eps0ij
658 C Uncomment for AL's type of SC correlation interactions.
660 num_conti=num_conti+1
662 facont(num_conti,i)=fcont*eps0ij
663 fprimcont=eps0ij*fprimcont/rij
665 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
666 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
667 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
668 C Uncomment following 3 lines for Skolnick's type of SC correlation.
669 gacont(1,num_conti,i)=-fprimcont*xj
670 gacont(2,num_conti,i)=-fprimcont*yj
671 gacont(3,num_conti,i)=-fprimcont*zj
672 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
673 cd write (iout,'(2i3,3f10.5)')
674 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
680 num_cont(i)=num_conti
685 gvdwc(j,i)=expon*gvdwc(j,i)
686 gvdwx(j,i)=expon*gvdwx(j,i)
690 C******************************************************************************
694 C To save time, the factor of EXPON has been extracted from ALL components
695 C of GVDWC and GRADX. Remember to multiply them by this factor before further
698 C******************************************************************************
701 C-----------------------------------------------------------------------------
702 subroutine eljk(evdw)
704 C This subroutine calculates the interaction energy of nonbonded side chains
705 C assuming the LJK potential of interaction.
707 implicit real*8 (a-h,o-z)
709 include 'DIMENSIONS.ZSCOPT'
712 include 'COMMON.LOCAL'
713 include 'COMMON.CHAIN'
714 include 'COMMON.DERIV'
715 include 'COMMON.INTERACT'
716 include 'COMMON.WEIGHTDER'
717 include 'COMMON.IOUNITS'
718 include 'COMMON.NAMES'
723 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
726 eneps_temp(j,i)=0.0d0
737 C Calculate SC interaction energy.
740 do j=istart(i,iint),iend(i,iint)
745 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
747 e_augm=augm(itypi,itypj)*fac_augm
750 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
751 fac=r_shift_inv**expon
752 e1=fac*fac*aa(itypi,itypj)
753 e2=fac*bb(itypi,itypj)
755 ij=icant(itypi,itypj)
756 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
757 & /dabs(eps(itypi,itypj))
758 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
759 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
760 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
761 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
762 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
763 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
764 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
765 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
769 C Calculate the components of the gradient in DC and X
771 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
776 gvdwx(k,i)=gvdwx(k,i)-gg(k)
777 gvdwx(k,j)=gvdwx(k,j)+gg(k)
781 gvdwc(l,k)=gvdwc(l,k)+gg(l)
791 gvdwc(j,i)=expon*gvdwc(j,i)
792 gvdwx(j,i)=expon*gvdwx(j,i)
798 C-----------------------------------------------------------------------------
801 C This subroutine calculates the interaction energy of nonbonded side chains
802 C assuming the Berne-Pechukas potential of interaction.
804 implicit real*8 (a-h,o-z)
806 include 'DIMENSIONS.ZSCOPT'
809 include 'COMMON.LOCAL'
810 include 'COMMON.CHAIN'
811 include 'COMMON.DERIV'
812 include 'COMMON.NAMES'
813 include 'COMMON.INTERACT'
814 include 'COMMON.WEIGHTDER'
815 include 'COMMON.IOUNITS'
816 include 'COMMON.CALC'
818 c double precision rrsave(maxdim)
824 eneps_temp(j,i)=0.0d0
828 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
830 c if (icall.eq.0) then
842 dxi=dc_norm(1,nres+i)
843 dyi=dc_norm(2,nres+i)
844 dzi=dc_norm(3,nres+i)
845 dsci_inv=vbld_inv(i+nres)
847 C Calculate SC interaction energy.
850 do j=istart(i,iint),iend(i,iint)
853 dscj_inv=vbld_inv(j+nres)
854 chi1=chi(itypi,itypj)
855 chi2=chi(itypj,itypi)
862 alf12=0.5D0*(alf1+alf2)
863 C For diagnostics only!!!
876 dxj=dc_norm(1,nres+j)
877 dyj=dc_norm(2,nres+j)
878 dzj=dc_norm(3,nres+j)
879 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
880 cd if (icall.eq.0) then
886 C Calculate the angle-dependent terms of energy & contributions to derivatives.
888 C Calculate whole angle-dependent part of epsilon and contributions
890 fac=(rrij*sigsq)**expon2
891 e1=fac*fac*aa(itypi,itypj)
892 e2=fac*bb(itypi,itypj)
893 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
894 eps2der=evdwij*eps3rt
895 eps3der=evdwij*eps2rt
896 evdwij=evdwij*eps2rt*eps3rt
897 ij=icant(itypi,itypj)
898 aux=eps1*eps2rt**2*eps3rt**2
899 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
900 & /dabs(eps(itypi,itypj))
901 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
905 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
906 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
907 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
908 cd & restyp(itypi),i,restyp(itypj),j,
909 cd & epsi,sigm,chi1,chi2,chip1,chip2,
910 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
911 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
914 C Calculate gradient components.
915 e1=e1*eps1*eps2rt**2*eps3rt**2
916 fac=-expon*(e1+evdwij)
919 C Calculate radial part of the gradient
923 C Calculate the angular part of the gradient and sum add the contributions
924 C to the appropriate components of the Cartesian gradient.
933 C-----------------------------------------------------------------------------
936 C This subroutine calculates the interaction energy of nonbonded side chains
937 C assuming the Gay-Berne potential of interaction.
939 implicit real*8 (a-h,o-z)
941 include 'DIMENSIONS.ZSCOPT'
944 include 'COMMON.LOCAL'
945 include 'COMMON.CHAIN'
946 include 'COMMON.DERIV'
947 include 'COMMON.NAMES'
948 include 'COMMON.INTERACT'
949 include 'COMMON.WEIGHTDER'
950 include 'COMMON.IOUNITS'
951 include 'COMMON.CALC'
958 eneps_temp(j,i)=0.0d0
962 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
965 c if (icall.gt.0) lprn=.true.
973 dxi=dc_norm(1,nres+i)
974 dyi=dc_norm(2,nres+i)
975 dzi=dc_norm(3,nres+i)
976 dsci_inv=vbld_inv(i+nres)
978 C Calculate SC interaction energy.
981 do j=istart(i,iint),iend(i,iint)
984 dscj_inv=vbld_inv(j+nres)
985 sig0ij=sigma(itypi,itypj)
986 chi1=chi(itypi,itypj)
987 chi2=chi(itypj,itypi)
994 alf12=0.5D0*(alf1+alf2)
995 C For diagnostics only!!!
1008 dxj=dc_norm(1,nres+j)
1009 dyj=dc_norm(2,nres+j)
1010 dzj=dc_norm(3,nres+j)
1011 c write (iout,*) i,j,xj,yj,zj
1012 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1014 C Calculate angle-dependent terms of energy and contributions to their
1018 sig=sig0ij*dsqrt(sigsq)
1019 rij_shift=1.0D0/rij-sig+sig0ij
1020 C I hate to put IF's in the loops, but here don't have another choice!!!!
1021 if (rij_shift.le.0.0D0) then
1026 c---------------------------------------------------------------
1027 rij_shift=1.0D0/rij_shift
1028 fac=rij_shift**expon
1029 e1=fac*fac*aa(itypi,itypj)
1030 e2=fac*bb(itypi,itypj)
1031 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1032 eps2der=evdwij*eps3rt
1033 eps3der=evdwij*eps2rt
1034 evdwij=evdwij*eps2rt*eps3rt
1036 ij=icant(itypi,itypj)
1037 aux=eps1*eps2rt**2*eps3rt**2
1038 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1039 c & /dabs(eps(itypi,itypj))
1040 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1041 c-----------------------
1042 eps0ij=eps(itypi,itypj)
1043 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1/ftune_eps(eps0ij)
1044 rr0ij=r0(itypi,itypj)
1045 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps0ij
1046 c eneps_temp(2,ij)=eneps_temp(2,ij)+(rij_shift*rr0ij)**expon
1047 c-----------------------
1048 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1049 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1050 c & aux*e2/eps(itypi,itypj)
1052 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1053 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1054 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1055 & restyp(itypi),i,restyp(itypj),j,
1056 & epsi,sigm,chi1,chi2,chip1,chip2,
1057 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1058 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1062 C Calculate gradient components.
1063 e1=e1*eps1*eps2rt**2*eps3rt**2
1064 fac=-expon*(e1+evdwij)*rij_shift
1067 C Calculate the radial part of the gradient
1071 C Calculate angular part of the gradient.
1079 C-----------------------------------------------------------------------------
1080 subroutine egbv(evdw)
1082 C This subroutine calculates the interaction energy of nonbonded side chains
1083 C assuming the Gay-Berne-Vorobjev potential of interaction.
1085 implicit real*8 (a-h,o-z)
1086 include 'DIMENSIONS'
1087 include 'DIMENSIONS.ZSCOPT'
1088 include 'COMMON.GEO'
1089 include 'COMMON.VAR'
1090 include 'COMMON.LOCAL'
1091 include 'COMMON.CHAIN'
1092 include 'COMMON.DERIV'
1093 include 'COMMON.NAMES'
1094 include 'COMMON.INTERACT'
1095 include 'COMMON.WEIGHTDER'
1096 include 'COMMON.IOUNITS'
1097 include 'COMMON.CALC'
1098 common /srutu/ icall
1104 eneps_temp(j,i)=0.0d0
1108 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1111 c if (icall.gt.0) lprn=.true.
1113 do i=iatsc_s,iatsc_e
1119 dxi=dc_norm(1,nres+i)
1120 dyi=dc_norm(2,nres+i)
1121 dzi=dc_norm(3,nres+i)
1122 dsci_inv=vbld_inv(i+nres)
1124 C Calculate SC interaction energy.
1126 do iint=1,nint_gr(i)
1127 do j=istart(i,iint),iend(i,iint)
1130 dscj_inv=vbld_inv(j+nres)
1131 sig0ij=sigma(itypi,itypj)
1132 r0ij=r0(itypi,itypj)
1133 chi1=chi(itypi,itypj)
1134 chi2=chi(itypj,itypi)
1141 alf12=0.5D0*(alf1+alf2)
1142 C For diagnostics only!!!
1155 dxj=dc_norm(1,nres+j)
1156 dyj=dc_norm(2,nres+j)
1157 dzj=dc_norm(3,nres+j)
1158 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1160 C Calculate angle-dependent terms of energy and contributions to their
1164 sig=sig0ij*dsqrt(sigsq)
1165 rij_shift=1.0D0/rij-sig+r0ij
1166 C I hate to put IF's in the loops, but here don't have another choice!!!!
1167 if (rij_shift.le.0.0D0) then
1172 c---------------------------------------------------------------
1173 rij_shift=1.0D0/rij_shift
1174 fac=rij_shift**expon
1175 e1=fac*fac*aa(itypi,itypj)
1176 e2=fac*bb(itypi,itypj)
1177 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1178 eps2der=evdwij*eps3rt
1179 eps3der=evdwij*eps2rt
1180 fac_augm=rrij**expon
1181 e_augm=augm(itypi,itypj)*fac_augm
1182 evdwij=evdwij*eps2rt*eps3rt
1183 evdw=evdw+evdwij+e_augm
1184 ij=icant(itypi,itypj)
1185 aux=eps1*eps2rt**2*eps3rt**2
1186 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1187 & /dabs(eps(itypi,itypj))
1188 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1189 c eneps_temp(ij)=eneps_temp(ij)
1190 c & +(evdwij+e_augm)/eps(itypi,itypj)
1192 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1193 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1194 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1195 c & restyp(itypi),i,restyp(itypj),j,
1196 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1197 c & chi1,chi2,chip1,chip2,
1198 c & eps1,eps2rt**2,eps3rt**2,
1199 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1203 C Calculate gradient components.
1204 e1=e1*eps1*eps2rt**2*eps3rt**2
1205 fac=-expon*(e1+evdwij)*rij_shift
1207 fac=rij*fac-2*expon*rrij*e_augm
1208 C Calculate the radial part of the gradient
1212 C Calculate angular part of the gradient.
1220 C-----------------------------------------------------------------------------
1221 SUBROUTINE emomo(evdw,evdw_p,evdw_m)
1223 C This subroutine calculates the interaction energy of nonbonded side chains
1224 C assuming the Gay-Berne potential of interaction.
1227 INCLUDE 'DIMENSIONS'
1228 INCLUDE 'DIMENSIONS.ZSCOPT'
1229 INCLUDE 'COMMON.CALC'
1230 INCLUDE 'COMMON.CONTROL'
1231 INCLUDE 'COMMON.CHAIN'
1232 INCLUDE 'COMMON.DERIV'
1233 INCLUDE 'COMMON.EMP'
1234 INCLUDE 'COMMON.GEO'
1235 INCLUDE 'COMMON.INTERACT'
1236 INCLUDE 'COMMON.IOUNITS'
1237 INCLUDE 'COMMON.LOCAL'
1238 INCLUDE 'COMMON.NAMES'
1239 INCLUDE 'COMMON.VAR'
1240 INCLUDE 'COMMON.WEIGHTDER'
1242 double precision scalar
1243 double precision ener(4)
1249 IF (energy_dec) write (iout,'(a)')
1250 & ' AAi i AAj j 1/rij Rtail Rhead evdwij Fcav Ecl
1251 & Egb Epol Fisocav Elj Equad evdw'
1256 ccccc energy_dec=.false.
1257 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1259 c if (icall.eq.0) lprn=.false.
1262 DO i = iatsc_s, iatsc_e
1264 c itypi1 = itype(i+1)
1265 dxi = dc_norm(1,nres+i)
1266 dyi = dc_norm(2,nres+i)
1267 dzi = dc_norm(3,nres+i)
1268 c dsci_inv=dsc_inv(itypi)
1269 dsci_inv = vbld_inv(i+nres)
1271 c ctail(k,1) = c(k, i+nres)
1272 c & - dtail(1,itypi,itypj) * dc_norm(k, nres+i)
1277 c!-------------------------------------------------------------------
1278 C Calculate SC interaction energy.
1279 DO iint = 1, nint_gr(i)
1280 DO j = istart(i,iint), iend(i,iint)
1281 c! initialize variables for electrostatic gradients
1282 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
1284 c dscj_inv = dsc_inv(itypj)
1285 dscj_inv = vbld_inv(j+nres)
1286 c! rij holds 1/(distance of Calpha atoms)
1287 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
1289 c!-------------------------------------------------------------------
1290 C Calculate angle-dependent terms of energy and contributions to their
1294 c! DO troll = 10, 5000
1298 c! sqom1 = om1 * om1
1299 c! sqom2 = om2 * om2
1300 c! sqom12 = om12 * om12
1301 c! rij = 5.0d0 / troll
1303 c! Rtail = troll / 5.0d0
1304 c! Rhead = troll / 5.0d0
1305 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1306 c! Rtail = dsqrt((Rtail**2)
1307 c! & +((dabs(dtail(1,itypi,itypj)-dtail(2,itypi,itypj)))**2))
1308 c! rij = 1.0d0/Rtail
1312 c! this should be in elgrad_init but om's are calculated by sc_angular
1313 c! which in turn is used by older potentials
1314 c! which proves how tangled UNRES code is >.<
1315 c! om = omega, sqom = om^2
1318 sqom12 = om12 * om12
1320 c! now we calculate EGB - Gey-Berne
1321 c! It will be summed up in evdwij and saved in evdw
1322 sigsq = 1.0D0 / sigsq
1323 sig = sig0ij * dsqrt(sigsq)
1324 c! rij_shift = 1.0D0 / rij - sig + sig0ij
1325 rij_shift = Rtail - sig + sig0ij
1326 IF (rij_shift.le.0.0D0) THEN
1330 sigder = -sig * sigsq
1331 rij_shift = 1.0D0 / rij_shift
1332 fac = rij_shift**expon
1333 c1 = fac * fac * aa(itypi,itypj)
1335 c2 = fac * bb(itypi,itypj)
1337 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
1338 eps2der = eps3rt * evdwij
1339 eps3der = eps2rt * evdwij
1340 c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
1341 evdwij = eps2rt * eps3rt * evdwij
1343 c! write (*,*) "Gey Berne = ", evdwij
1345 IF (bb(itypi,itypj).gt.0) THEN
1346 evdw_p = evdw_p + evdwij
1348 evdw_m = evdw_m + evdwij
1354 c!-------------------------------------------------------------------
1355 c! Calculate some components of GGB
1356 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
1357 fac = -expon * (c1 + evdwij) * rij_shift
1358 sigder = fac * sigder
1360 c! Calculate distance derivative
1367 c! write (*,*) "gg(1) = ", gg(1)
1368 c! write (*,*) "gg(2) = ", gg(2)
1369 c! write (*,*) "gg(3) = ", gg(3)
1370 c! The angular derivatives of GGB are brought together in sc_grad
1371 c!-------------------------------------------------------------------
1374 c! Catch gly-gly interactions to skip calculation of something that
1377 IF (itypi.eq.10.and.itypj.eq.10) THEN
1385 c! we are not 2 glycines, so we calculate Fcav (and maybe more)
1386 fac = chis1 * sqom1 + chis2 * sqom2
1387 & - 2.0d0 * chis12 * om1 * om2 * om12
1388 c! we will use pom later in Gcav, so dont mess with it!
1389 pom = 1.0d0 - chis1 * chis2 * sqom12
1391 Lambf = (1.0d0 - (fac / pom))
1392 Lambf = dsqrt(Lambf)
1395 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
1396 c! write (*,*) "sparrow = ", sparrow
1397 Chif = Rtail * sparrow
1398 ChiLambf = Chif * Lambf
1399 eagle = dsqrt(ChiLambf)
1400 bat = ChiLambf ** 11.0d0
1402 top = b1 * ( eagle + b2 * ChiLambf - b3 )
1403 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
1406 c! write (*,*) "sig1 = ",sig1
1407 c! write (*,*) "sig2 = ",sig2
1408 c! write (*,*) "Rtail = ",Rtail
1409 c! write (*,*) "sparrow = ",sparrow
1410 c! write (*,*) "Chis1 = ", chis1
1411 c! write (*,*) "Chis2 = ", chis2
1412 c! write (*,*) "Chis12 = ", chis12
1413 c! write (*,*) "om1 = ", om1
1414 c! write (*,*) "om2 = ", om2
1415 c! write (*,*) "om12 = ", om12
1416 c! write (*,*) "sqom1 = ", sqom1
1417 c! write (*,*) "sqom2 = ", sqom2
1418 c! write (*,*) "sqom12 = ", sqom12
1419 c! write (*,*) "Lambf = ",Lambf
1420 c! write (*,*) "b1 = ",b1
1421 c! write (*,*) "b2 = ",b2
1422 c! write (*,*) "b3 = ",b3
1423 c! write (*,*) "b4 = ",b4
1424 c! write (*,*) "top = ",top
1425 c! write (*,*) "bot = ",bot
1428 c! write (*,*) "Fcav = ", Fcav
1429 c!-------------------------------------------------------------------
1430 c! derivative of Fcav is Gcav...
1431 c!---------------------------------------------------
1433 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
1434 dbot = 12.0d0 * b4 * bat * Lambf
1435 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
1437 c! write (*,*) "dFcav/dR = ", dFdR
1439 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
1440 dbot = 12.0d0 * b4 * bat * Chif
1442 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
1443 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
1444 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
1445 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
1447 dFdL = ((dtop * bot - top * dbot) / botsq)
1449 dCAVdOM1 = dFdL * ( dFdOM1 )
1450 dCAVdOM2 = dFdL * ( dFdOM2 )
1451 dCAVdOM12 = dFdL * ( dFdOM12 )
1452 c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1
1453 c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2
1454 c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12
1456 c!-------------------------------------------------------------------
1457 c! Finally, add the distance derivatives of GB and Fcav to gvdwc
1458 c! Pom is used here to project the gradient vector into
1459 c! cartesian coordinates and at the same time contains
1460 c! dXhb/dXsc derivative (for charged amino acids
1461 c! location of hydrophobic centre of interaction is not
1462 c! the same as geometric centre of side chain, this
1463 c! derivative takes that into account)
1464 c! derivatives of omega angles will be added in sc_grad
1467 ertail(k) = Rtail_distance(k)/Rtail
1469 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
1470 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
1471 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1472 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1474 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1475 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1476 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
1477 gvdwx(k,i) = gvdwx(k,i)
1478 & - (( dFdR + gg(k) ) * pom)
1479 c! & - ( dFdR * pom )
1480 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
1481 gvdwx(k,j) = gvdwx(k,j)
1482 & + (( dFdR + gg(k) ) * pom)
1483 c! & + ( dFdR * pom )
1485 gvdwc(k,i) = gvdwc(k,i)
1486 & - (( dFdR + gg(k) ) * ertail(k))
1487 c! & - ( dFdR * ertail(k))
1489 gvdwc(k,j) = gvdwc(k,j)
1490 & + (( dFdR + gg(k) ) * ertail(k))
1491 c! & + ( dFdR * ertail(k))
1494 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1495 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1498 c!-------------------------------------------------------------------
1499 c! Compute head-head and head-tail energies for each state
1501 isel = iabs(Qi) + iabs(Qj)
1503 c! No charges - do nothing
1506 ELSE IF (isel.eq.4) THEN
1507 c! Calculate dipole-dipole interactions
1511 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
1512 c! Charge-nonpolar interactions
1516 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
1517 c! Nonpolar-charge interactions
1521 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
1522 c! Charge-dipole interactions
1523 CALL eqd(ecl, elj, epol)
1524 eheadtail = ECL + elj + epol
1526 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
1527 c! Dipole-charge interactions
1528 CALL edq(ecl, elj, epol)
1529 eheadtail = ECL + elj + epol
1531 ELSE IF ((isel.eq.2.and.
1532 & iabs(Qi).eq.1).and.
1533 & nstate(itypi,itypj).eq.1) THEN
1534 c! Same charge-charge interaction ( +/+ or -/- )
1535 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
1536 eheadtail = ECL + Egb + Epol + Fisocav + Elj
1538 ELSE IF ((isel.eq.2.and.
1539 & iabs(Qi).eq.1).and.
1540 & nstate(itypi,itypj).ne.1) THEN
1541 c! Different charge-charge interaction ( +/- or -/+ )
1543 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1545 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
1546 c! write (*,*) "evdw = ", evdw
1547 c! write (*,*) "Fcav = ", Fcav
1548 c! write (*,*) "eheadtail = ", eheadtail
1552 ij=icant(itypi,itypj)
1553 eneps_temp(1,ij)=eneps_temp(1,ij)+evdwij
1554 eneps_temp(2,ij)=eneps_temp(2,ij)+Fcav
1555 eneps_temp(3,ij)=eheadtail
1556 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,9f16.7)')
1557 & restyp(itype(i)),i,restyp(itype(j)),j,
1558 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1560 IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
1561 & restyp(itype(i)),i,restyp(itype(j)),j,
1562 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1569 c!-------------------------------------------------------------------
1570 c! As all angular derivatives are done, now we sum them up,
1571 c! then transform and project into cartesian vectors and add to gvdwc
1572 c! We call sc_grad always, with the exception of +/- interaction.
1573 c! This is because energy_quad subroutine needs to handle
1574 c! this job in his own way.
1575 c! This IS probably not very efficient and SHOULD be optimised
1576 c! but it will require major restructurization of emomo
1577 c! so it will be left as it is for now
1578 c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj)
1579 IF (nstate(itypi,itypj).eq.1) THEN
1581 IF (bb(itypi,itypj).gt.0) THEN
1590 c!-------------------------------------------------------------------
1595 c write (iout,*) "Number of loop steps in EGB:",ind
1596 c energy_dec=.false.
1598 END SUBROUTINE emomo
1600 C-----------------------------------------------------------------------------
1601 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
1603 INCLUDE 'DIMENSIONS'
1604 INCLUDE 'DIMENSIONS.ZSCOPT'
1605 INCLUDE 'COMMON.CALC'
1606 INCLUDE 'COMMON.CHAIN'
1607 INCLUDE 'COMMON.CONTROL'
1608 INCLUDE 'COMMON.DERIV'
1609 INCLUDE 'COMMON.EMP'
1610 INCLUDE 'COMMON.GEO'
1611 INCLUDE 'COMMON.INTERACT'
1612 INCLUDE 'COMMON.IOUNITS'
1613 INCLUDE 'COMMON.LOCAL'
1614 INCLUDE 'COMMON.NAMES'
1615 INCLUDE 'COMMON.VAR'
1616 double precision scalar, facd3, facd4, federmaus, adler
1617 c! Epol and Gpol analytical parameters
1618 alphapol1 = alphapol(itypi,itypj)
1619 alphapol2 = alphapol(itypj,itypi)
1620 c! Fisocav and Gisocav analytical parameters
1621 al1 = alphiso(1,itypi,itypj)
1622 al2 = alphiso(2,itypi,itypj)
1623 al3 = alphiso(3,itypi,itypj)
1624 al4 = alphiso(4,itypi,itypj)
1626 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1627 & + sigiso2(itypi,itypj)**2.0d0))
1629 pis = sig0head(itypi,itypj)
1630 eps_head = epshead(itypi,itypj)
1631 Rhead_sq = Rhead * Rhead
1632 c! R1 - distance between head of ith side chain and tail of jth sidechain
1633 c! R2 - distance between head of jth side chain and tail of ith sidechain
1637 c! Calculate head-to-tail distances needed by Epol
1638 R1=R1+(ctail(k,2)-chead(k,1))**2
1639 R2=R2+(chead(k,2)-ctail(k,1))**2
1645 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1646 c! & +dhead(1,1,itypi,itypj))**2))
1647 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1648 c! & +dhead(2,1,itypi,itypj))**2))
1649 c!-------------------------------------------------------------------
1650 c! Coulomb electrostatic interaction
1651 Ecl = (332.0d0 * Qij) / Rhead
1652 c! derivative of Ecl is Gcl...
1653 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
1657 c!-------------------------------------------------------------------
1658 c! Generalised Born Solvent Polarization
1659 c! Charged head polarizes the solvent
1660 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1661 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1662 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1663 c! Derivative of Egb is Ggb...
1664 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1665 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1667 dGGBdR = dGGBdFGB * dFGBdR
1668 c!-------------------------------------------------------------------
1669 c! Fisocav - isotropic cavity creation term
1670 c! or "how much energy it costs to put charged head in water"
1672 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1673 bot = (1.0d0 + al4 * pom**12.0d0)
1676 c! write (*,*) "Rhead = ",Rhead
1677 c! write (*,*) "csig = ",csig
1678 c! write (*,*) "pom = ",pom
1679 c! write (*,*) "al1 = ",al1
1680 c! write (*,*) "al2 = ",al2
1681 c! write (*,*) "al3 = ",al3
1682 c! write (*,*) "al4 = ",al4
1683 c! write (*,*) "top = ",top
1684 c! write (*,*) "bot = ",bot
1685 c! Derivative of Fisocav is GCV...
1686 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1687 dbot = 12.0d0 * al4 * pom ** 11.0d0
1688 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1689 c!-------------------------------------------------------------------
1691 c! Polarization energy - charged heads polarize hydrophobic "neck"
1692 MomoFac1 = (1.0d0 - chi1 * sqom2)
1693 MomoFac2 = (1.0d0 - chi2 * sqom1)
1694 RR1 = ( R1 * R1 ) / MomoFac1
1695 RR2 = ( R2 * R2 ) / MomoFac2
1696 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1697 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1698 fgb1 = sqrt( RR1 + a12sq * ee1 )
1699 fgb2 = sqrt( RR2 + a12sq * ee2 )
1700 epol = 332.0d0 * eps_inout_fac * (
1701 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1703 c write (*,*) "eps_inout_fac = ",eps_inout_fac
1704 c write (*,*) "alphapol1 = ", alphapol1
1705 c write (*,*) "alphapol2 = ", alphapol2
1706 c write (*,*) "fgb1 = ", fgb1
1707 c write (*,*) "fgb2 = ", fgb2
1708 c write (*,*) "epol = ", epol
1709 c! derivative of Epol is Gpol...
1710 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1712 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1714 dFGBdR1 = ( (R1 / MomoFac1)
1715 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1716 & / ( 2.0d0 * fgb1 )
1717 dFGBdR2 = ( (R2 / MomoFac2)
1718 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1719 & / ( 2.0d0 * fgb2 )
1720 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1721 & * ( 2.0d0 - 0.5d0 * ee1) )
1722 & / ( 2.0d0 * fgb1 )
1723 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1724 & * ( 2.0d0 - 0.5d0 * ee2) )
1725 & / ( 2.0d0 * fgb2 )
1726 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1728 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1730 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1732 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1734 c!-------------------------------------------------------------------
1736 c! Lennard-Jones 6-12 interaction between heads
1737 pom = (pis / Rhead)**6.0d0
1738 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1739 c! derivative of Elj is Glj
1740 dGLJdR = 4.0d0 * eps_head
1741 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1742 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1743 c!-------------------------------------------------------------------
1744 c! Return the results
1745 c! These things do the dRdX derivatives, that is
1746 c! allow us to change what we see from function that changes with
1747 c! distance to function that changes with LOCATION (of the interaction
1750 erhead(k) = Rhead_distance(k)/Rhead
1751 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1752 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1755 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1756 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1757 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1758 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1759 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1760 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1761 facd1 = d1 * vbld_inv(i+nres)
1762 facd2 = d2 * vbld_inv(j+nres)
1763 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1764 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1766 c! Now we add appropriate partial derivatives (one in each dimension)
1768 hawk = (erhead_tail(k,1) +
1769 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
1770 condor = (erhead_tail(k,2) +
1771 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
1773 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1774 gvdwx(k,i) = gvdwx(k,i)
1779 & - dPOLdR2 * (erhead_tail(k,2)
1780 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1783 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1784 gvdwx(k,j) = gvdwx(k,j)
1788 & + dPOLdR1 * (erhead_tail(k,1)
1789 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1790 & + dPOLdR2 * condor
1793 gvdwc(k,i) = gvdwc(k,i)
1794 & - dGCLdR * erhead(k)
1795 & - dGGBdR * erhead(k)
1796 & - dGCVdR * erhead(k)
1797 & - dPOLdR1 * erhead_tail(k,1)
1798 & - dPOLdR2 * erhead_tail(k,2)
1799 & - dGLJdR * erhead(k)
1801 gvdwc(k,j) = gvdwc(k,j)
1802 & + dGCLdR * erhead(k)
1803 & + dGGBdR * erhead(k)
1804 & + dGCVdR * erhead(k)
1805 & + dPOLdR1 * erhead_tail(k,1)
1806 & + dPOLdR2 * erhead_tail(k,2)
1807 & + dGLJdR * erhead(k)
1812 c!-------------------------------------------------------------------
1813 SUBROUTINE energy_quad
1814 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1816 INCLUDE 'DIMENSIONS'
1817 INCLUDE 'DIMENSIONS.ZSCOPT'
1818 INCLUDE 'COMMON.CALC'
1819 INCLUDE 'COMMON.CHAIN'
1820 INCLUDE 'COMMON.CONTROL'
1821 INCLUDE 'COMMON.DERIV'
1822 INCLUDE 'COMMON.EMP'
1823 INCLUDE 'COMMON.GEO'
1824 INCLUDE 'COMMON.INTERACT'
1825 INCLUDE 'COMMON.IOUNITS'
1826 INCLUDE 'COMMON.LOCAL'
1827 INCLUDE 'COMMON.NAMES'
1828 INCLUDE 'COMMON.VAR'
1829 double precision scalar
1830 double precision ener(4)
1831 double precision dcosom1(3),dcosom2(3)
1832 c! used in Epol derivatives
1833 double precision facd3, facd4
1834 double precision federmaus, adler
1835 c! Epol and Gpol analytical parameters
1836 alphapol1 = alphapol(itypi,itypj)
1837 alphapol2 = alphapol(itypj,itypi)
1838 c! Fisocav and Gisocav analytical parameters
1839 al1 = alphiso(1,itypi,itypj)
1840 al2 = alphiso(2,itypi,itypj)
1841 al3 = alphiso(3,itypi,itypj)
1842 al4 = alphiso(4,itypi,itypj)
1844 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1845 & + sigiso2(itypi,itypj)**2.0d0))
1847 w1 = wqdip(1,itypi,itypj)
1848 w2 = wqdip(2,itypi,itypj)
1849 pis = sig0head(itypi,itypj)
1850 eps_head = epshead(itypi,itypj)
1851 c! First things first:
1852 c! We need to do sc_grad's job with GB and Fcav
1854 & eps2der * eps2rt_om1
1855 & - 2.0D0 * alf1 * eps3der
1856 & + sigder * sigsq_om1
1859 & eps2der * eps2rt_om2
1860 & + 2.0D0 * alf2 * eps3der
1861 & + sigder * sigsq_om2
1864 & evdwij * eps1_om12
1865 & + eps2der * eps2rt_om12
1866 & - 2.0D0 * alf12 * eps3der
1867 & + sigder *sigsq_om12
1869 c! now some magical transformations to project gradient into
1870 c! three cartesian vectors
1872 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1873 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1874 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
1875 c! this acts on hydrophobic center of interaction
1876 gvdwx(k,i)= gvdwx(k,i) - gg(k)
1877 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1878 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1879 gvdwx(k,j)= gvdwx(k,j) + gg(k)
1880 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1881 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1882 c! this acts on Calpha
1883 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1884 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1886 c! sc_grad is done, now we will compute
1895 c! d1 = dhead(1, 1, itypi, itypj)
1896 c! d2 = dhead(2, 1, itypi, itypj)
1897 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1898 c! & +dhead(1,ii,itypi,itypj))**2))
1899 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1900 c! & +dhead(2,jj,itypi,itypj))**2))
1901 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1902 c! END OF ENERGY DEBUG
1903 c*************************************************************
1904 DO istate = 1, nstate(itypi,itypj)
1905 c*************************************************************
1906 IF (istate.ne.1) THEN
1907 IF (istate.lt.3) THEN
1913 d1 = dhead(1,ii,itypi,itypj)
1914 d2 = dhead(2,jj,itypi,itypj)
1916 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
1917 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
1918 Rhead_distance(k) = chead(k,2) - chead(k,1)
1920 c! pitagoras (root of sum of squares)
1922 & (Rhead_distance(1)*Rhead_distance(1))
1923 & + (Rhead_distance(2)*Rhead_distance(2))
1924 & + (Rhead_distance(3)*Rhead_distance(3)))
1926 Rhead_sq = Rhead * Rhead
1928 c! R1 - distance between head of ith side chain and tail of jth sidechain
1929 c! R2 - distance between head of jth side chain and tail of ith sidechain
1933 c! Calculate head-to-tail distances
1934 R1=R1+(ctail(k,2)-chead(k,1))**2
1935 R2=R2+(chead(k,2)-ctail(k,1))**2
1942 c! write (*,*) "istate = ", istate
1943 c! write (*,*) "ii = ", ii
1944 c! write (*,*) "jj = ", jj
1945 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1946 c! & +dhead(1,ii,itypi,itypj))**2))
1947 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1948 c! & +dhead(2,jj,itypi,itypj))**2))
1949 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1950 c! Rhead_sq = Rhead * Rhead
1951 c! write (*,*) "d1 = ",d1
1952 c! write (*,*) "d2 = ",d2
1953 c! write (*,*) "R1 = ",R1
1954 c! write (*,*) "R2 = ",R2
1955 c! write (*,*) "Rhead = ",Rhead
1956 c! END OF ENERGY DEBUG
1958 c!-------------------------------------------------------------------
1959 c! Coulomb electrostatic interaction
1960 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
1962 c! write (*,*) "Ecl = ", Ecl
1963 c! derivative of Ecl is Gcl...
1964 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
1969 c!-------------------------------------------------------------------
1970 c! Generalised Born Solvent Polarization
1971 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1972 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1973 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1975 c! write (*,*) "a1*a2 = ", a12sq
1976 c! write (*,*) "Rhead = ", Rhead
1977 c! write (*,*) "Rhead_sq = ", Rhead_sq
1978 c! write (*,*) "ee = ", ee
1979 c! write (*,*) "Fgb = ", Fgb
1980 c! write (*,*) "fac = ", eps_inout_fac
1981 c! write (*,*) "Qij = ", Qij
1982 c! write (*,*) "Egb = ", Egb
1983 c! Derivative of Egb is Ggb...
1984 c! dFGBdR is used by Quad's later...
1985 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1986 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1988 dGGBdR = dGGBdFGB * dFGBdR
1990 c!-------------------------------------------------------------------
1991 c! Fisocav - isotropic cavity creation term
1993 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1994 bot = (1.0d0 + al4 * pom**12.0d0)
1998 c! write (*,*) "pom = ",pom
1999 c! write (*,*) "al1 = ",al1
2000 c! write (*,*) "al2 = ",al2
2001 c! write (*,*) "al3 = ",al3
2002 c! write (*,*) "al4 = ",al4
2003 c! write (*,*) "top = ",top
2004 c! write (*,*) "bot = ",bot
2005 c! write (*,*) "Fisocav = ", Fisocav
2007 c! Derivative of Fisocav is GCV...
2008 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
2009 dbot = 12.0d0 * al4 * pom ** 11.0d0
2010 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
2012 c!-------------------------------------------------------------------
2013 c! Polarization energy
2015 MomoFac1 = (1.0d0 - chi1 * sqom2)
2016 MomoFac2 = (1.0d0 - chi2 * sqom1)
2017 RR1 = ( R1 * R1 ) / MomoFac1
2018 RR2 = ( R2 * R2 ) / MomoFac2
2019 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2020 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
2021 fgb1 = sqrt( RR1 + a12sq * ee1 )
2022 fgb2 = sqrt( RR2 + a12sq * ee2 )
2023 epol = 332.0d0 * eps_inout_fac * (
2024 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
2026 c! derivative of Epol is Gpol...
2027 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2029 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2031 dFGBdR1 = ( (R1 / MomoFac1)
2032 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2033 & / ( 2.0d0 * fgb1 )
2034 dFGBdR2 = ( (R2 / MomoFac2)
2035 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2036 & / ( 2.0d0 * fgb2 )
2037 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2038 & * ( 2.0d0 - 0.5d0 * ee1) )
2039 & / ( 2.0d0 * fgb1 )
2040 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2041 & * ( 2.0d0 - 0.5d0 * ee2) )
2042 & / ( 2.0d0 * fgb2 )
2043 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2045 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2047 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2049 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2051 c!-------------------------------------------------------------------
2053 pom = (pis / Rhead)**6.0d0
2054 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2056 c! derivative of Elj is Glj
2057 dGLJdR = 4.0d0 * eps_head
2058 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2059 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2061 c!-------------------------------------------------------------------
2063 IF (Wqd.ne.0.0d0) THEN
2064 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
2065 & - 37.5d0 * ( sqom1 + sqom2 )
2066 & + 157.5d0 * ( sqom1 * sqom2 )
2067 & - 45.0d0 * om1*om2*om12
2068 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
2071 c! derivative of Equad...
2072 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
2075 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
2076 c! dQUADdOM1 = 0.0d0
2078 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
2079 c! dQUADdOM2 = 0.0d0
2081 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
2082 c! dQUADdOM12 = 0.0d0
2087 c!-------------------------------------------------------------------
2088 c! Return the results
2090 eom1 = dPOLdOM1 + dQUADdOM1
2091 eom2 = dPOLdOM2 + dQUADdOM2
2093 c! now some magical transformations to project gradient into
2094 c! three cartesian vectors
2096 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
2097 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
2098 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
2102 erhead(k) = Rhead_distance(k)/Rhead
2103 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2104 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2106 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2107 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2108 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2109 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2110 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2111 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2112 facd1 = d1 * vbld_inv(i+nres)
2113 facd2 = d2 * vbld_inv(j+nres)
2114 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2115 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2116 c! Throw the results into gheadtail which holds gradients
2117 c! for each micro-state
2119 hawk = erhead_tail(k,1) +
2120 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
2121 condor = erhead_tail(k,2) +
2122 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
2124 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2125 c! this acts on hydrophobic center of interaction
2126 gheadtail(k,1,1) = gheadtail(k,1,1)
2131 & - dPOLdR2 * (erhead_tail(k,2)
2132 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2136 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2137 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2139 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2140 c! this acts on hydrophobic center of interaction
2141 gheadtail(k,2,1) = gheadtail(k,2,1)
2145 & + dPOLdR1 * (erhead_tail(k,1)
2146 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2147 & + dPOLdR2 * condor
2151 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2152 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2154 c! this acts on Calpha
2155 gheadtail(k,3,1) = gheadtail(k,3,1)
2156 & - dGCLdR * erhead(k)
2157 & - dGGBdR * erhead(k)
2158 & - dGCVdR * erhead(k)
2159 & - dPOLdR1 * erhead_tail(k,1)
2160 & - dPOLdR2 * erhead_tail(k,2)
2161 & - dGLJdR * erhead(k)
2162 & - dQUADdR * erhead(k)
2165 c! this acts on Calpha
2166 gheadtail(k,4,1) = gheadtail(k,4,1)
2167 & + dGCLdR * erhead(k)
2168 & + dGGBdR * erhead(k)
2169 & + dGCVdR * erhead(k)
2170 & + dPOLdR1 * erhead_tail(k,1)
2171 & + dPOLdR2 * erhead_tail(k,2)
2172 & + dGLJdR * erhead(k)
2173 & + dQUADdR * erhead(k)
2176 c! write(*,*) "ECL = ", Ecl
2177 c! write(*,*) "Egb = ", Egb
2178 c! write(*,*) "Epol = ", Epol
2179 c! write(*,*) "Fisocav = ", Fisocav
2180 c! write(*,*) "Elj = ", Elj
2181 c! write(*,*) "Equad = ", Equad
2182 c! write(*,*) "wstate = ", wstate(istate,itypi,itypj)
2183 c! write(*,*) "eheadtail = ", eheadtail
2184 c! write(*,*) "TROLL = ", dexp(-betaT * ener(istate))
2185 c! write(*,*) "dGCLdR = ", dGCLdR
2186 c! write(*,*) "dGGBdR = ", dGGBdR
2187 c! write(*,*) "dGCVdR = ", dGCVdR
2188 c! write(*,*) "dPOLdR1 = ", dPOLdR1
2189 c! write(*,*) "dPOLdR2 = ", dPOLdR2
2190 c! write(*,*) "dGLJdR = ", dGLJdR
2191 c! write(*,*) "dQUADdR = ", dQUADdR
2192 c! write(*,*) "tuna(",k,") = ", tuna(k)
2193 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
2194 eheadtail = eheadtail
2195 & + wstate(istate, itypi, itypj)
2196 & * dexp(-betaT * ener(istate))
2197 c! foreach cartesian dimension
2199 c! foreach of two gvdwx and gvdwc
2201 gheadtail(k,l,2) = gheadtail(k,l,2)
2202 & + wstate( istate, itypi, itypj )
2203 & * dexp(-betaT * ener(istate))
2204 & * gheadtail(k,l,1)
2205 gheadtail(k,l,1) = 0.0d0
2209 c! Here ended the gigantic DO istate = 1, 4, which starts
2210 c! at the beggining of the subroutine
2214 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
2216 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
2217 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
2218 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
2219 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
2221 gheadtail(k,l,1) = 0.0d0
2222 gheadtail(k,l,2) = 0.0d0
2225 eheadtail = (-dlog(eheadtail)) / betaT
2232 END SUBROUTINE energy_quad
2233 c!-------------------------------------------------------------------
2234 SUBROUTINE eqn(Epol)
2236 INCLUDE 'DIMENSIONS'
2237 INCLUDE 'DIMENSIONS.ZSCOPT'
2238 INCLUDE 'COMMON.CALC'
2239 INCLUDE 'COMMON.CHAIN'
2240 INCLUDE 'COMMON.CONTROL'
2241 INCLUDE 'COMMON.DERIV'
2242 INCLUDE 'COMMON.EMP'
2243 INCLUDE 'COMMON.GEO'
2244 INCLUDE 'COMMON.INTERACT'
2245 INCLUDE 'COMMON.IOUNITS'
2246 INCLUDE 'COMMON.LOCAL'
2247 INCLUDE 'COMMON.NAMES'
2248 INCLUDE 'COMMON.VAR'
2249 double precision scalar, facd4, federmaus
2250 alphapol1 = alphapol(itypi,itypj)
2251 c! R1 - distance between head of ith side chain and tail of jth sidechain
2254 c! Calculate head-to-tail distances
2255 R1=R1+(ctail(k,2)-chead(k,1))**2
2260 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2261 c! & +dhead(1,1,itypi,itypj))**2))
2262 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2263 c! & +dhead(2,1,itypi,itypj))**2))
2264 c--------------------------------------------------------------------
2265 c Polarization energy
2267 MomoFac1 = (1.0d0 - chi1 * sqom2)
2268 RR1 = R1 * R1 / MomoFac1
2269 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2270 fgb1 = sqrt( RR1 + a12sq * ee1)
2271 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2273 c!------------------------------------------------------------------
2274 c! derivative of Epol is Gpol...
2275 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2277 dFGBdR1 = ( (R1 / MomoFac1)
2278 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2279 & / ( 2.0d0 * fgb1 )
2280 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2281 & * (2.0d0 - 0.5d0 * ee1) )
2283 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2286 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2288 c!-------------------------------------------------------------------
2289 c! Return the results
2290 c! (see comments in Eqq)
2292 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2294 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2295 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2296 facd1 = d1 * vbld_inv(i+nres)
2297 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2300 hawk = (erhead_tail(k,1) +
2301 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2303 gvdwx(k,i) = gvdwx(k,i)
2305 gvdwx(k,j) = gvdwx(k,j)
2306 & + dPOLdR1 * (erhead_tail(k,1)
2307 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2309 gvdwc(k,i) = gvdwc(k,i)
2310 & - dPOLdR1 * erhead_tail(k,1)
2311 gvdwc(k,j) = gvdwc(k,j)
2312 & + dPOLdR1 * erhead_tail(k,1)
2319 c!-------------------------------------------------------------------
2323 SUBROUTINE enq(Epol)
2325 INCLUDE 'DIMENSIONS'
2326 INCLUDE 'DIMENSIONS.ZSCOPT'
2327 INCLUDE 'COMMON.CALC'
2328 INCLUDE 'COMMON.CHAIN'
2329 INCLUDE 'COMMON.CONTROL'
2330 INCLUDE 'COMMON.DERIV'
2331 INCLUDE 'COMMON.EMP'
2332 INCLUDE 'COMMON.GEO'
2333 INCLUDE 'COMMON.INTERACT'
2334 INCLUDE 'COMMON.IOUNITS'
2335 INCLUDE 'COMMON.LOCAL'
2336 INCLUDE 'COMMON.NAMES'
2337 INCLUDE 'COMMON.VAR'
2338 double precision scalar, facd3, adler
2339 alphapol2 = alphapol(itypj,itypi)
2340 c! R2 - distance between head of jth side chain and tail of ith sidechain
2343 c! Calculate head-to-tail distances
2344 R2=R2+(chead(k,2)-ctail(k,1))**2
2349 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2350 c! & +dhead(1,1,itypi,itypj))**2))
2351 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2352 c! & +dhead(2,1,itypi,itypj))**2))
2353 c------------------------------------------------------------------------
2354 c Polarization energy
2355 MomoFac2 = (1.0d0 - chi2 * sqom1)
2356 RR2 = R2 * R2 / MomoFac2
2357 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2358 fgb2 = sqrt(RR2 + a12sq * ee2)
2359 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2361 c!-------------------------------------------------------------------
2362 c! derivative of Epol is Gpol...
2363 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2365 dFGBdR2 = ( (R2 / MomoFac2)
2366 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2368 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2369 & * (2.0d0 - 0.5d0 * ee2) )
2371 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2373 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2376 c!-------------------------------------------------------------------
2377 c! Return the results
2378 c! (See comments in Eqq)
2380 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2382 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2383 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2384 facd2 = d2 * vbld_inv(j+nres)
2385 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2387 condor = (erhead_tail(k,2)
2388 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2390 gvdwx(k,i) = gvdwx(k,i)
2391 & - dPOLdR2 * (erhead_tail(k,2)
2392 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2393 gvdwx(k,j) = gvdwx(k,j)
2394 & + dPOLdR2 * condor
2396 gvdwc(k,i) = gvdwc(k,i)
2397 & - dPOLdR2 * erhead_tail(k,2)
2398 gvdwc(k,j) = gvdwc(k,j)
2399 & + dPOLdR2 * erhead_tail(k,2)
2406 c!-------------------------------------------------------------------
2409 SUBROUTINE eqd(Ecl,Elj,Epol)
2411 INCLUDE 'DIMENSIONS'
2412 INCLUDE 'DIMENSIONS.ZSCOPT'
2413 INCLUDE 'COMMON.CALC'
2414 INCLUDE 'COMMON.CHAIN'
2415 INCLUDE 'COMMON.CONTROL'
2416 INCLUDE 'COMMON.DERIV'
2417 INCLUDE 'COMMON.EMP'
2418 INCLUDE 'COMMON.GEO'
2419 INCLUDE 'COMMON.INTERACT'
2420 INCLUDE 'COMMON.IOUNITS'
2421 INCLUDE 'COMMON.LOCAL'
2422 INCLUDE 'COMMON.NAMES'
2423 INCLUDE 'COMMON.VAR'
2424 double precision scalar, facd4, federmaus
2425 alphapol1 = alphapol(itypi,itypj)
2426 w1 = wqdip(1,itypi,itypj)
2427 w2 = wqdip(2,itypi,itypj)
2428 pis = sig0head(itypi,itypj)
2429 eps_head = epshead(itypi,itypj)
2430 c!-------------------------------------------------------------------
2431 c! R1 - distance between head of ith side chain and tail of jth sidechain
2434 c! Calculate head-to-tail distances
2435 R1=R1+(ctail(k,2)-chead(k,1))**2
2440 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2441 c! & +dhead(1,1,itypi,itypj))**2))
2442 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2443 c! & +dhead(2,1,itypi,itypj))**2))
2445 c!-------------------------------------------------------------------
2447 sparrow = w1 * Qi * om1
2448 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2449 Ecl = sparrow / Rhead**2.0d0
2450 & - hawk / Rhead**4.0d0
2451 c!-------------------------------------------------------------------
2452 c! derivative of ecl is Gcl
2454 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2455 & + 4.0d0 * hawk / Rhead**5.0d0
2457 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2459 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2460 c--------------------------------------------------------------------
2461 c Polarization energy
2463 MomoFac1 = (1.0d0 - chi1 * sqom2)
2464 RR1 = R1 * R1 / MomoFac1
2465 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2466 fgb1 = sqrt( RR1 + a12sq * ee1)
2467 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2469 c!------------------------------------------------------------------
2470 c! derivative of Epol is Gpol...
2471 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2473 dFGBdR1 = ( (R1 / MomoFac1)
2474 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2475 & / ( 2.0d0 * fgb1 )
2476 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2477 & * (2.0d0 - 0.5d0 * ee1) )
2479 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2482 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2484 c!-------------------------------------------------------------------
2486 pom = (pis / Rhead)**6.0d0
2487 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2488 c! derivative of Elj is Glj
2489 dGLJdR = 4.0d0 * eps_head
2490 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2491 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2492 c!-------------------------------------------------------------------
2493 c! Return the results
2495 erhead(k) = Rhead_distance(k)/Rhead
2496 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2499 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2500 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2501 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2502 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2503 facd1 = d1 * vbld_inv(i+nres)
2504 facd2 = d2 * vbld_inv(j+nres)
2505 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2508 hawk = (erhead_tail(k,1) +
2509 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2511 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2512 gvdwx(k,i) = gvdwx(k,i)
2517 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2518 gvdwx(k,j) = gvdwx(k,j)
2520 & + dPOLdR1 * (erhead_tail(k,1)
2521 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2525 gvdwc(k,i) = gvdwc(k,i)
2526 & - dGCLdR * erhead(k)
2527 & - dPOLdR1 * erhead_tail(k,1)
2528 & - dGLJdR * erhead(k)
2530 gvdwc(k,j) = gvdwc(k,j)
2531 & + dGCLdR * erhead(k)
2532 & + dPOLdR1 * erhead_tail(k,1)
2533 & + dGLJdR * erhead(k)
2540 c!-------------------------------------------------------------------
2543 SUBROUTINE edq(Ecl,Elj,Epol)
2545 INCLUDE 'DIMENSIONS'
2546 INCLUDE 'DIMENSIONS.ZSCOPT'
2547 INCLUDE 'COMMON.CALC'
2548 INCLUDE 'COMMON.CHAIN'
2549 INCLUDE 'COMMON.CONTROL'
2550 INCLUDE 'COMMON.DERIV'
2551 INCLUDE 'COMMON.EMP'
2552 INCLUDE 'COMMON.GEO'
2553 INCLUDE 'COMMON.INTERACT'
2554 INCLUDE 'COMMON.IOUNITS'
2555 INCLUDE 'COMMON.LOCAL'
2556 INCLUDE 'COMMON.NAMES'
2557 INCLUDE 'COMMON.VAR'
2558 double precision scalar, facd3, adler
2559 alphapol2 = alphapol(itypj,itypi)
2560 w1 = wqdip(1,itypi,itypj)
2561 w2 = wqdip(2,itypi,itypj)
2562 pis = sig0head(itypi,itypj)
2563 eps_head = epshead(itypi,itypj)
2564 c!-------------------------------------------------------------------
2565 c! R2 - distance between head of jth side chain and tail of ith sidechain
2568 c! Calculate head-to-tail distances
2569 R2=R2+(chead(k,2)-ctail(k,1))**2
2574 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2575 c! & +dhead(1,1,itypi,itypj))**2))
2576 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2577 c! & +dhead(2,1,itypi,itypj))**2))
2580 c!-------------------------------------------------------------------
2582 sparrow = w1 * Qi * om1
2583 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2584 ECL = sparrow / Rhead**2.0d0
2585 & - hawk / Rhead**4.0d0
2586 c!-------------------------------------------------------------------
2587 c! derivative of ecl is Gcl
2589 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2590 & + 4.0d0 * hawk / Rhead**5.0d0
2592 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2594 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2595 c--------------------------------------------------------------------
2596 c Polarization energy
2598 MomoFac2 = (1.0d0 - chi2 * sqom1)
2599 RR2 = R2 * R2 / MomoFac2
2600 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2601 fgb2 = sqrt(RR2 + a12sq * ee2)
2602 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2604 c! derivative of Epol is Gpol...
2605 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2607 dFGBdR2 = ( (R2 / MomoFac2)
2608 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2610 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2611 & * (2.0d0 - 0.5d0 * ee2) )
2613 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2615 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2618 c!-------------------------------------------------------------------
2620 pom = (pis / Rhead)**6.0d0
2621 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2622 c! derivative of Elj is Glj
2623 dGLJdR = 4.0d0 * eps_head
2624 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2625 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2626 c!-------------------------------------------------------------------
2627 c! Return the results
2628 c! (see comments in Eqq)
2630 erhead(k) = Rhead_distance(k)/Rhead
2631 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2633 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2634 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2635 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2636 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2637 facd1 = d1 * vbld_inv(i+nres)
2638 facd2 = d2 * vbld_inv(j+nres)
2639 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2642 condor = (erhead_tail(k,2)
2643 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2645 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2646 gvdwx(k,i) = gvdwx(k,i)
2648 & - dPOLdR2 * (erhead_tail(k,2)
2649 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2652 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2653 gvdwx(k,j) = gvdwx(k,j)
2655 & + dPOLdR2 * condor
2659 gvdwc(k,i) = gvdwc(k,i)
2660 & - dGCLdR * erhead(k)
2661 & - dPOLdR2 * erhead_tail(k,2)
2662 & - dGLJdR * erhead(k)
2664 gvdwc(k,j) = gvdwc(k,j)
2665 & + dGCLdR * erhead(k)
2666 & + dPOLdR2 * erhead_tail(k,2)
2667 & + dGLJdR * erhead(k)
2674 C--------------------------------------------------------------------
2679 INCLUDE 'DIMENSIONS'
2680 INCLUDE 'DIMENSIONS.ZSCOPT'
2681 INCLUDE 'COMMON.CALC'
2682 INCLUDE 'COMMON.CHAIN'
2683 INCLUDE 'COMMON.CONTROL'
2684 INCLUDE 'COMMON.DERIV'
2685 INCLUDE 'COMMON.EMP'
2686 INCLUDE 'COMMON.GEO'
2687 INCLUDE 'COMMON.INTERACT'
2688 INCLUDE 'COMMON.IOUNITS'
2689 INCLUDE 'COMMON.LOCAL'
2690 INCLUDE 'COMMON.NAMES'
2691 INCLUDE 'COMMON.VAR'
2692 double precision scalar
2693 c! csig = sigiso(itypi,itypj)
2694 w1 = wqdip(1,itypi,itypj)
2695 w2 = wqdip(2,itypi,itypj)
2696 c!-------------------------------------------------------------------
2698 fac = (om12 - 3.0d0 * om1 * om2)
2699 c1 = (w1 / (Rhead**3.0d0)) * fac
2700 c2 = (w2 / Rhead ** 6.0d0)
2701 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2703 c! write (*,*) "w1 = ", w1
2704 c! write (*,*) "w2 = ", w2
2705 c! write (*,*) "om1 = ", om1
2706 c! write (*,*) "om2 = ", om2
2707 c! write (*,*) "om12 = ", om12
2708 c! write (*,*) "fac = ", fac
2709 c! write (*,*) "c1 = ", c1
2710 c! write (*,*) "c2 = ", c2
2711 c! write (*,*) "Ecl = ", Ecl
2712 c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
2713 c! write (*,*) "c2_2 = ",
2714 c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2715 c!-------------------------------------------------------------------
2716 c! dervative of ECL is GCL...
2718 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
2719 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
2720 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
2723 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
2724 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2725 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
2728 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
2729 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2730 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
2733 c1 = w1 / (Rhead ** 3.0d0)
2734 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
2736 c!-------------------------------------------------------------------
2737 c! Return the results
2738 c! (see comments in Eqq)
2740 erhead(k) = Rhead_distance(k)/Rhead
2742 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2743 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2744 facd1 = d1 * vbld_inv(i+nres)
2745 facd2 = d2 * vbld_inv(j+nres)
2748 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2749 gvdwx(k,i) = gvdwx(k,i)
2751 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2752 gvdwx(k,j) = gvdwx(k,j)
2755 gvdwc(k,i) = gvdwc(k,i)
2756 & - dGCLdR * erhead(k)
2757 gvdwc(k,j) = gvdwc(k,j)
2758 & + dGCLdR * erhead(k)
2764 c!-------------------------------------------------------------------
2767 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
2770 INCLUDE 'DIMENSIONS'
2771 INCLUDE 'DIMENSIONS.ZSCOPT'
2772 c! itypi, itypj, i, j, k, l, chead,
2773 INCLUDE 'COMMON.CALC'
2775 INCLUDE 'COMMON.CHAIN'
2777 INCLUDE 'COMMON.DERIV'
2778 c! electrostatic gradients-specific variables
2779 INCLUDE 'COMMON.EMP'
2780 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
2781 INCLUDE 'COMMON.INTERACT'
2783 c INCLUDE 'COMMON.MD'
2784 c! io for debug, disable it in final builds
2785 INCLUDE 'COMMON.IOUNITS'
2786 double precision Rb /1.987D-3/
2787 c!-------------------------------------------------------------------
2790 c! what amino acid is the aminoacid j'th?
2792 c! 1/(Gas Constant * Thermostate temperature) = BetaT
2793 c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
2795 c! BetaT = 1.0d0 / (t_bath * Rb)
2796 BetaT = 1.0d0 / (298.0d0 * Rb)
2798 sig0ij = sigma( itypi,itypj )
2799 chi1 = chi( itypi, itypj )
2800 chi2 = chi( itypj, itypi )
2802 chip1 = chipp( itypi, itypj )
2803 chip2 = chipp( itypj, itypi )
2804 chip12 = chip1 * chip2
2805 c! not used by momo potential, but needed by sc_angular which is shared
2806 c! by all energy_potential subroutines
2810 c! location, location, location
2811 xj = c( 1, nres+j ) - xi
2812 yj = c( 2, nres+j ) - yi
2813 zj = c( 3, nres+j ) - zi
2814 dxj = dc_norm( 1, nres+j )
2815 dyj = dc_norm( 2, nres+j )
2816 dzj = dc_norm( 3, nres+j )
2817 c! distance from center of chain(?) to polar/charged head
2818 c! write (*,*) "istate = ", 1
2819 c! write (*,*) "ii = ", 1
2820 c! write (*,*) "jj = ", 1
2821 d1 = dhead(1, 1, itypi, itypj)
2822 d2 = dhead(2, 1, itypi, itypj)
2824 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
2825 c! a12sq = a12sq * a12sq
2826 c! charge of amino acid itypi is...
2831 chis1 = chis(itypi,itypj)
2832 chis2 = chis(itypj,itypi)
2833 chis12 = chis1 * chis2
2834 sig1 = sigmap1(itypi,itypj)
2835 sig2 = sigmap2(itypi,itypj)
2836 c! write (*,*) "sig1 = ", sig1
2837 c! write (*,*) "sig2 = ", sig2
2838 c! alpha factors from Fcav/Gcav
2839 b1 = alphasur(1,itypi,itypj)
2840 b2 = alphasur(2,itypi,itypj)
2841 b3 = alphasur(3,itypi,itypj)
2842 b4 = alphasur(4,itypi,itypj)
2843 c! used to determine whether we want to do quadrupole calculations
2844 wqd = wquad(itypi, itypj)
2846 eps_in = epsintab(itypi,itypj)
2847 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
2848 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
2849 c!-------------------------------------------------------------------
2850 c! tail location and distance calculations
2853 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
2854 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
2856 c! tail distances will be themselves usefull elswhere
2857 c1 (in Gcav, for example)
2858 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
2859 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
2860 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
2862 & (Rtail_distance(1)*Rtail_distance(1))
2863 & + (Rtail_distance(2)*Rtail_distance(2))
2864 & + (Rtail_distance(3)*Rtail_distance(3)))
2865 c!-------------------------------------------------------------------
2866 c! Calculate location and distance between polar heads
2867 c! distance between heads
2868 c! for each one of our three dimensional space...
2870 c! location of polar head is computed by taking hydrophobic centre
2871 c! and moving by a d1 * dc_norm vector
2872 c! see unres publications for very informative images
2873 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
2874 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
2876 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
2877 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
2878 Rhead_distance(k) = chead(k,2) - chead(k,1)
2880 c! pitagoras (root of sum of squares)
2882 & (Rhead_distance(1)*Rhead_distance(1))
2883 & + (Rhead_distance(2)*Rhead_distance(2))
2884 & + (Rhead_distance(3)*Rhead_distance(3)))
2885 c!-------------------------------------------------------------------
2886 c! zero everything that should be zero'ed
2899 END SUBROUTINE elgrad_init
2902 C-----------------------------------------------------------------------------
2903 subroutine sc_angular
2904 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2905 C om12. Called by ebp, egb, and egbv.
2907 include 'COMMON.CALC'
2911 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2912 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2913 om12=dxi*dxj+dyi*dyj+dzi*dzj
2915 C Calculate eps1(om12) and its derivative in om12
2916 faceps1=1.0D0-om12*chiom12
2917 faceps1_inv=1.0D0/faceps1
2918 eps1=dsqrt(faceps1_inv)
2919 C Following variable is eps1*deps1/dom12
2920 eps1_om12=faceps1_inv*chiom12
2921 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2926 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2927 sigsq=1.0D0-facsig*faceps1_inv
2928 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2929 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2930 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2931 C Calculate eps2 and its derivatives in om1, om2, and om12.
2934 chipom12=chip12*om12
2935 facp=1.0D0-om12*chipom12
2937 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2938 C Following variable is the square root of eps2
2939 eps2rt=1.0D0-facp1*facp_inv
2940 C Following three variables are the derivatives of the square root of eps
2941 C in om1, om2, and om12.
2942 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2943 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2944 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2945 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2946 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2947 C Calculate whole angle-dependent part of epsilon and contributions
2948 C to its derivatives
2951 C----------------------------------------------------------------------------
2953 implicit real*8 (a-h,o-z)
2954 include 'DIMENSIONS'
2955 include 'DIMENSIONS.ZSCOPT'
2956 include 'COMMON.CHAIN'
2957 include 'COMMON.DERIV'
2958 include 'COMMON.CALC'
2959 double precision dcosom1(3),dcosom2(3)
2960 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2961 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2962 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2963 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2965 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2966 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2969 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2972 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2973 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2974 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2975 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2976 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2977 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2980 C Calculate the components of the gradient in DC and X
2984 gvdwc(l,k)=gvdwc(l,k)+gg(l)
2989 c------------------------------------------------------------------------------
2990 subroutine vec_and_deriv
2991 implicit real*8 (a-h,o-z)
2992 include 'DIMENSIONS'
2993 include 'DIMENSIONS.ZSCOPT'
2994 include 'COMMON.IOUNITS'
2995 include 'COMMON.GEO'
2996 include 'COMMON.VAR'
2997 include 'COMMON.LOCAL'
2998 include 'COMMON.CHAIN'
2999 include 'COMMON.VECTORS'
3000 include 'COMMON.DERIV'
3001 include 'COMMON.INTERACT'
3002 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
3003 C Compute the local reference systems. For reference system (i), the
3004 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
3005 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
3007 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
3008 if (i.eq.nres-1) then
3009 C Case of the last full residue
3010 C Compute the Z-axis
3011 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
3012 costh=dcos(pi-theta(nres))
3013 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3018 C Compute the derivatives of uz
3020 uzder(2,1,1)=-dc_norm(3,i-1)
3021 uzder(3,1,1)= dc_norm(2,i-1)
3022 uzder(1,2,1)= dc_norm(3,i-1)
3024 uzder(3,2,1)=-dc_norm(1,i-1)
3025 uzder(1,3,1)=-dc_norm(2,i-1)
3026 uzder(2,3,1)= dc_norm(1,i-1)
3029 uzder(2,1,2)= dc_norm(3,i)
3030 uzder(3,1,2)=-dc_norm(2,i)
3031 uzder(1,2,2)=-dc_norm(3,i)
3033 uzder(3,2,2)= dc_norm(1,i)
3034 uzder(1,3,2)= dc_norm(2,i)
3035 uzder(2,3,2)=-dc_norm(1,i)
3038 C Compute the Y-axis
3041 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
3044 C Compute the derivatives of uy
3047 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
3048 & -dc_norm(k,i)*dc_norm(j,i-1)
3049 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3051 uyder(j,j,1)=uyder(j,j,1)-costh
3052 uyder(j,j,2)=1.0d0+uyder(j,j,2)
3057 uygrad(l,k,j,i)=uyder(l,k,j)
3058 uzgrad(l,k,j,i)=uzder(l,k,j)
3062 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3063 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3064 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3065 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3069 C Compute the Z-axis
3070 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
3071 costh=dcos(pi-theta(i+2))
3072 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3077 C Compute the derivatives of uz
3079 uzder(2,1,1)=-dc_norm(3,i+1)
3080 uzder(3,1,1)= dc_norm(2,i+1)
3081 uzder(1,2,1)= dc_norm(3,i+1)
3083 uzder(3,2,1)=-dc_norm(1,i+1)
3084 uzder(1,3,1)=-dc_norm(2,i+1)
3085 uzder(2,3,1)= dc_norm(1,i+1)
3088 uzder(2,1,2)= dc_norm(3,i)
3089 uzder(3,1,2)=-dc_norm(2,i)
3090 uzder(1,2,2)=-dc_norm(3,i)
3092 uzder(3,2,2)= dc_norm(1,i)
3093 uzder(1,3,2)= dc_norm(2,i)
3094 uzder(2,3,2)=-dc_norm(1,i)
3097 C Compute the Y-axis
3100 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3103 C Compute the derivatives of uy
3106 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
3107 & -dc_norm(k,i)*dc_norm(j,i+1)
3108 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3110 uyder(j,j,1)=uyder(j,j,1)-costh
3111 uyder(j,j,2)=1.0d0+uyder(j,j,2)
3116 uygrad(l,k,j,i)=uyder(l,k,j)
3117 uzgrad(l,k,j,i)=uzder(l,k,j)
3121 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3122 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3123 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3124 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3130 vbld_inv_temp(1)=vbld_inv(i+1)
3131 if (i.lt.nres-1) then
3132 vbld_inv_temp(2)=vbld_inv(i+2)
3134 vbld_inv_temp(2)=vbld_inv(i)
3139 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
3140 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
3148 c------------------------------------------------------------------------------
3149 subroutine set_matrices
3150 implicit real*8 (a-h,o-z)
3151 include 'DIMENSIONS'
3155 integer status(MPI_STATUS_SIZE)
3157 include 'DIMENSIONS.ZSCOPT'
3158 include 'COMMON.IOUNITS'
3159 include 'COMMON.GEO'
3160 include 'COMMON.VAR'
3161 include 'COMMON.LOCAL'
3162 include 'COMMON.CHAIN'
3163 include 'COMMON.DERIV'
3164 include 'COMMON.INTERACT'
3165 include 'COMMON.CONTACTS'
3166 include 'COMMON.TORSION'
3167 include 'COMMON.VECTORS'
3168 include 'COMMON.FFIELD'
3169 double precision auxvec(2),auxmat(2,2)
3171 C Compute the virtual-bond-torsional-angle dependent quantities needed
3172 C to calculate the el-loc multibody terms of various order.
3174 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
3176 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3177 iti = itype2loc(itype(i-2))
3181 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3182 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3183 iti1 = itype2loc(itype(i-1))
3188 cost1=dcos(theta(i-1))
3189 sint1=dsin(theta(i-1))
3191 sint1cub=sint1sq*sint1
3192 sint1cost1=2*sint1*cost1
3194 write (iout,*) "bnew1",i,iti
3195 write (iout,*) (bnew1(k,1,iti),k=1,3)
3196 write (iout,*) (bnew1(k,2,iti),k=1,3)
3197 write (iout,*) "bnew2",i,iti
3198 write (iout,*) (bnew2(k,1,iti),k=1,3)
3199 write (iout,*) (bnew2(k,2,iti),k=1,3)
3202 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
3204 gtb1(k,i-2)=cost1*b1k-sint1sq*
3205 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
3206 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
3208 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
3209 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
3212 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
3213 cc(1,k,i-2)=sint1sq*aux
3214 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
3215 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
3216 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
3217 dd(1,k,i-2)=sint1sq*aux
3218 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
3219 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
3221 cc(2,1,i-2)=cc(1,2,i-2)
3222 cc(2,2,i-2)=-cc(1,1,i-2)
3223 gtcc(2,1,i-2)=gtcc(1,2,i-2)
3224 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
3225 dd(2,1,i-2)=dd(1,2,i-2)
3226 dd(2,2,i-2)=-dd(1,1,i-2)
3227 gtdd(2,1,i-2)=gtdd(1,2,i-2)
3228 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
3231 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
3232 EE(l,k,i-2)=sint1sq*aux
3234 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
3237 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
3238 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
3239 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
3240 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
3242 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
3243 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
3244 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
3246 c b1tilde(1,i-2)=b1(1,i-2)
3247 c b1tilde(2,i-2)=-b1(2,i-2)
3248 c b2tilde(1,i-2)=b2(1,i-2)
3249 c b2tilde(2,i-2)=-b2(2,i-2)
3251 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
3252 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
3253 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
3254 write (iout,*) 'theta=', theta(i-1)
3257 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3258 iti = itype2loc(itype(i-2))
3262 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3263 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3264 iti1 = itype2loc(itype(i-1))
3274 CC(k,l,i-2)=ccold(k,l,iti)
3275 DD(k,l,i-2)=ddold(k,l,iti)
3276 EE(k,l,i-2)=eeold(k,l,iti)
3280 b1tilde(1,i-2)= b1(1,i-2)
3281 b1tilde(2,i-2)=-b1(2,i-2)
3282 b2tilde(1,i-2)= b2(1,i-2)
3283 b2tilde(2,i-2)=-b2(2,i-2)
3285 Ctilde(1,1,i-2)= CC(1,1,i-2)
3286 Ctilde(1,2,i-2)= CC(1,2,i-2)
3287 Ctilde(2,1,i-2)=-CC(2,1,i-2)
3288 Ctilde(2,2,i-2)=-CC(2,2,i-2)
3290 Dtilde(1,1,i-2)= DD(1,1,i-2)
3291 Dtilde(1,2,i-2)= DD(1,2,i-2)
3292 Dtilde(2,1,i-2)=-DD(2,1,i-2)
3293 Dtilde(2,2,i-2)=-DD(2,2,i-2)
3294 c write(iout,*) "i",i," iti",iti
3295 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
3296 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
3299 if (i .lt. nres+1) then
3336 if (i .gt. 3 .and. i .lt. nres+1) then
3337 obrot_der(1,i-2)=-sin1
3338 obrot_der(2,i-2)= cos1
3339 Ugder(1,1,i-2)= sin1
3340 Ugder(1,2,i-2)=-cos1
3341 Ugder(2,1,i-2)=-cos1
3342 Ugder(2,2,i-2)=-sin1
3345 obrot2_der(1,i-2)=-dwasin2
3346 obrot2_der(2,i-2)= dwacos2
3347 Ug2der(1,1,i-2)= dwasin2
3348 Ug2der(1,2,i-2)=-dwacos2
3349 Ug2der(2,1,i-2)=-dwacos2
3350 Ug2der(2,2,i-2)=-dwasin2
3352 obrot_der(1,i-2)=0.0d0
3353 obrot_der(2,i-2)=0.0d0
3354 Ugder(1,1,i-2)=0.0d0
3355 Ugder(1,2,i-2)=0.0d0
3356 Ugder(2,1,i-2)=0.0d0
3357 Ugder(2,2,i-2)=0.0d0
3358 obrot2_der(1,i-2)=0.0d0
3359 obrot2_der(2,i-2)=0.0d0
3360 Ug2der(1,1,i-2)=0.0d0
3361 Ug2der(1,2,i-2)=0.0d0
3362 Ug2der(2,1,i-2)=0.0d0
3363 Ug2der(2,2,i-2)=0.0d0
3365 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3366 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3367 iti = itype2loc(itype(i-2))
3371 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3372 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3373 iti1 = itype2loc(itype(i-1))
3377 cd write (iout,*) '*******i',i,' iti1',iti
3378 cd write (iout,*) 'b1',b1(:,iti)
3379 cd write (iout,*) 'b2',b2(:,iti)
3380 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3381 c if (i .gt. iatel_s+2) then
3382 if (i .gt. nnt+2) then
3383 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
3385 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
3386 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
3388 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
3389 c & EE(1,2,iti),EE(2,2,i)
3390 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
3391 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
3392 c write(iout,*) "Macierz EUG",
3393 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
3395 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3397 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
3398 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
3399 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3400 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
3401 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
3412 DtUg2(l,k,i-2)=0.0d0
3416 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3417 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3419 muder(k,i-2)=Ub2der(k,i-2)
3421 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3422 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3423 if (itype(i-1).le.ntyp) then
3424 iti1 = itype2loc(itype(i-1))
3432 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3435 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
3436 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
3437 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
3438 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
3439 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
3440 & ((ee(l,k,i-2),l=1,2),k=1,2)
3442 cd write (iout,*) 'mu1',mu1(:,i-2)
3443 cd write (iout,*) 'mu2',mu2(:,i-2)
3444 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3447 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3448 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
3449 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3450 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
3451 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3453 C Vectors and matrices dependent on a single virtual-bond dihedral.
3454 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
3455 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3456 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
3457 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
3458 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
3460 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3461 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
3462 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
3463 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
3467 C Matrices dependent on two consecutive virtual-bond dihedrals.
3468 C The order of matrices is from left to right.
3469 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
3472 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3474 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3475 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3477 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3478 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3480 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3481 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3482 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3488 C--------------------------------------------------------------------------
3489 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3491 C This subroutine calculates the average interaction energy and its gradient
3492 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3493 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3494 C The potential depends both on the distance of peptide-group centers and on
3495 C the orientation of the CA-CA virtual bonds.
3497 implicit real*8 (a-h,o-z)
3501 include 'DIMENSIONS'
3502 include 'DIMENSIONS.ZSCOPT'
3503 include 'COMMON.CONTROL'
3504 include 'COMMON.IOUNITS'
3505 include 'COMMON.GEO'
3506 include 'COMMON.VAR'
3507 include 'COMMON.LOCAL'
3508 include 'COMMON.CHAIN'
3509 include 'COMMON.DERIV'
3510 include 'COMMON.INTERACT'
3511 include 'COMMON.CONTACTS'
3512 include 'COMMON.TORSION'
3513 include 'COMMON.VECTORS'
3514 include 'COMMON.FFIELD'
3515 include 'COMMON.TIME1'
3516 include 'COMMON.SPLITELE'
3517 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3518 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3519 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3520 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3521 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3522 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3524 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3526 double precision scal_el /1.0d0/
3528 double precision scal_el /0.5d0/
3531 C 13-go grudnia roku pamietnego...
3532 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3533 & 0.0d0,1.0d0,0.0d0,
3534 & 0.0d0,0.0d0,1.0d0/
3535 cd write(iout,*) 'In EELEC'
3537 cd write(iout,*) 'Type',i
3538 cd write(iout,*) 'B1',B1(:,i)
3539 cd write(iout,*) 'B2',B2(:,i)
3540 cd write(iout,*) 'CC',CC(:,:,i)
3541 cd write(iout,*) 'DD',DD(:,:,i)
3542 cd write(iout,*) 'EE',EE(:,:,i)
3544 cd call check_vecgrad
3546 if (icheckgrad.eq.1) then
3548 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3550 dc_norm(k,i)=dc(k,i)*fac
3552 c write (iout,*) 'i',i,' fac',fac
3555 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3556 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3557 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3558 c call vec_and_deriv
3564 time_mat=time_mat+MPI_Wtime()-time01
3568 cd write (iout,*) 'i=',i
3570 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3573 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3574 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3587 cd print '(a)','Enter EELEC'
3588 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3590 gel_loc_loc(i)=0.0d0
3595 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3597 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3599 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3600 do i=iturn3_start,iturn3_end
3602 C write(iout,*) "tu jest i",i
3603 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3604 C changes suggested by Ana to avoid out of bounds
3605 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
3606 c & .or.((i+4).gt.nres)
3607 c & .or.((i-1).le.0)
3608 C end of changes by Ana
3609 C dobra zmiana wycofana
3610 & .or. itype(i+2).eq.ntyp1
3611 & .or. itype(i+3).eq.ntyp1) cycle
3612 C Adam: Instructions below will switch off existing interactions
3614 c if(itype(i-1).eq.ntyp1)cycle
3616 c if(i.LT.nres-3)then
3617 c if (itype(i+4).eq.ntyp1) cycle
3622 dx_normi=dc_norm(1,i)
3623 dy_normi=dc_norm(2,i)
3624 dz_normi=dc_norm(3,i)
3625 xmedi=c(1,i)+0.5d0*dxi
3626 ymedi=c(2,i)+0.5d0*dyi
3627 zmedi=c(3,i)+0.5d0*dzi
3628 xmedi=mod(xmedi,boxxsize)
3629 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3630 ymedi=mod(ymedi,boxysize)
3631 if (ymedi.lt.0) ymedi=ymedi+boxysize
3632 zmedi=mod(zmedi,boxzsize)
3633 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3635 call eelecij(i,i+2,ees,evdw1,eel_loc)
3636 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3637 num_cont_hb(i)=num_conti
3639 do i=iturn4_start,iturn4_end
3641 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3642 C changes suggested by Ana to avoid out of bounds
3643 c & .or.((i+5).gt.nres)
3644 c & .or.((i-1).le.0)
3645 C end of changes suggested by Ana
3646 & .or. itype(i+3).eq.ntyp1
3647 & .or. itype(i+4).eq.ntyp1
3648 c & .or. itype(i+5).eq.ntyp1
3649 c & .or. itype(i).eq.ntyp1
3650 c & .or. itype(i-1).eq.ntyp1
3655 dx_normi=dc_norm(1,i)
3656 dy_normi=dc_norm(2,i)
3657 dz_normi=dc_norm(3,i)
3658 xmedi=c(1,i)+0.5d0*dxi
3659 ymedi=c(2,i)+0.5d0*dyi
3660 zmedi=c(3,i)+0.5d0*dzi
3661 C Return atom into box, boxxsize is size of box in x dimension
3663 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3664 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3665 C Condition for being inside the proper box
3666 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3667 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3671 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3672 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3673 C Condition for being inside the proper box
3674 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3675 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3679 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3680 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3681 C Condition for being inside the proper box
3682 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3683 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3686 xmedi=mod(xmedi,boxxsize)
3687 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3688 ymedi=mod(ymedi,boxysize)
3689 if (ymedi.lt.0) ymedi=ymedi+boxysize
3690 zmedi=mod(zmedi,boxzsize)
3691 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3693 num_conti=num_cont_hb(i)
3694 c write(iout,*) "JESTEM W PETLI"
3695 call eelecij(i,i+3,ees,evdw1,eel_loc)
3696 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3697 & call eturn4(i,eello_turn4)
3698 num_cont_hb(i)=num_conti
3700 C Loop over all neighbouring boxes
3705 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3708 do i=iatel_s,iatel_e
3711 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3712 C changes suggested by Ana to avoid out of bounds
3713 c & .or.((i+2).gt.nres)
3714 c & .or.((i-1).le.0)
3715 C end of changes by Ana
3716 c & .or. itype(i+2).eq.ntyp1
3717 c & .or. itype(i-1).eq.ntyp1
3722 dx_normi=dc_norm(1,i)
3723 dy_normi=dc_norm(2,i)
3724 dz_normi=dc_norm(3,i)
3725 xmedi=c(1,i)+0.5d0*dxi
3726 ymedi=c(2,i)+0.5d0*dyi
3727 zmedi=c(3,i)+0.5d0*dzi
3728 xmedi=mod(xmedi,boxxsize)
3729 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3730 ymedi=mod(ymedi,boxysize)
3731 if (ymedi.lt.0) ymedi=ymedi+boxysize
3732 zmedi=mod(zmedi,boxzsize)
3733 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3734 C xmedi=xmedi+xshift*boxxsize
3735 C ymedi=ymedi+yshift*boxysize
3736 C zmedi=zmedi+zshift*boxzsize
3738 C Return tom into box, boxxsize is size of box in x dimension
3740 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3741 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3742 C Condition for being inside the proper box
3743 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3744 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3748 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3749 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3750 C Condition for being inside the proper box
3751 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3752 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3756 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3757 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3758 cC Condition for being inside the proper box
3759 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3760 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3764 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3765 num_conti=num_cont_hb(i)
3767 do j=ielstart(i),ielend(i)
3769 C write (iout,*) i,j
3771 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3772 C changes suggested by Ana to avoid out of bounds
3773 c & .or.((j+2).gt.nres)
3774 c & .or.((j-1).le.0)
3775 C end of changes by Ana
3776 c & .or.itype(j+2).eq.ntyp1
3777 c & .or.itype(j-1).eq.ntyp1
3779 call eelecij(i,j,ees,evdw1,eel_loc)
3781 num_cont_hb(i)=num_conti
3787 c write (iout,*) "Number of loop steps in EELEC:",ind
3789 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3790 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3792 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3793 ccc eel_loc=eel_loc+eello_turn3
3794 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3797 C-------------------------------------------------------------------------------
3798 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3799 implicit real*8 (a-h,o-z)
3800 include 'DIMENSIONS'
3801 include 'DIMENSIONS.ZSCOPT'
3805 include 'COMMON.CONTROL'
3806 include 'COMMON.IOUNITS'
3807 include 'COMMON.GEO'
3808 include 'COMMON.VAR'
3809 include 'COMMON.LOCAL'
3810 include 'COMMON.CHAIN'
3811 include 'COMMON.DERIV'
3812 include 'COMMON.INTERACT'
3813 include 'COMMON.CONTACTS'
3814 include 'COMMON.TORSION'
3815 include 'COMMON.VECTORS'
3816 include 'COMMON.FFIELD'
3817 include 'COMMON.TIME1'
3818 include 'COMMON.SPLITELE'
3819 include 'COMMON.SHIELD'
3820 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3821 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3822 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3823 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3824 & gmuij2(4),gmuji2(4)
3825 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3826 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3828 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3830 double precision scal_el /1.0d0/
3832 double precision scal_el /0.5d0/
3835 C 13-go grudnia roku pamietnego...
3836 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3837 & 0.0d0,1.0d0,0.0d0,
3838 & 0.0d0,0.0d0,1.0d0/
3839 integer xshift,yshift,zshift
3840 c time00=MPI_Wtime()
3841 cd write (iout,*) "eelecij",i,j
3845 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3846 aaa=app(iteli,itelj)
3847 bbb=bpp(iteli,itelj)
3848 ael6i=ael6(iteli,itelj)
3849 ael3i=ael3(iteli,itelj)
3853 dx_normj=dc_norm(1,j)
3854 dy_normj=dc_norm(2,j)
3855 dz_normj=dc_norm(3,j)
3856 C xj=c(1,j)+0.5D0*dxj-xmedi
3857 C yj=c(2,j)+0.5D0*dyj-ymedi
3858 C zj=c(3,j)+0.5D0*dzj-zmedi
3863 if (xj.lt.0) xj=xj+boxxsize
3865 if (yj.lt.0) yj=yj+boxysize
3867 if (zj.lt.0) zj=zj+boxzsize
3868 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3869 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3877 xj=xj_safe+xshift*boxxsize
3878 yj=yj_safe+yshift*boxysize
3879 zj=zj_safe+zshift*boxzsize
3880 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3881 if(dist_temp.lt.dist_init) then
3891 if (isubchap.eq.1) then
3900 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3902 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3903 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3904 C Condition for being inside the proper box
3905 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3906 c & (xj.lt.((-0.5d0)*boxxsize))) then
3910 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3911 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3912 C Condition for being inside the proper box
3913 c if ((yj.gt.((0.5d0)*boxysize)).or.
3914 c & (yj.lt.((-0.5d0)*boxysize))) then
3918 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3919 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3920 C Condition for being inside the proper box
3921 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3922 c & (zj.lt.((-0.5d0)*boxzsize))) then
3925 C endif !endPBC condintion
3929 rij=xj*xj+yj*yj+zj*zj
3931 sss=sscale(sqrt(rij))
3932 sssgrad=sscagrad(sqrt(rij))
3933 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
3934 c & " rlamb",rlamb," sss",sss
3935 c if (sss.gt.0.0d0) then
3941 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3942 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3943 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3944 fac=cosa-3.0D0*cosb*cosg
3946 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3947 if (j.eq.i+2) ev1=scal_el*ev1
3952 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3956 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3957 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3958 if (shield_mode.gt.0) then
3961 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3962 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3971 evdw1=evdw1+evdwij*sss
3972 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3973 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3974 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3975 cd & xmedi,ymedi,zmedi,xj,yj,zj
3977 if (energy_dec) then
3978 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
3980 &,iteli,itelj,aaa,evdw1,sss
3981 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
3982 &fac_shield(i),fac_shield(j)
3986 C Calculate contributions to the Cartesian gradient.
3989 facvdw=-6*rrmij*(ev1+evdwij)*sss
3990 facel=-3*rrmij*(el1+eesij)
3997 * Radial derivatives. First process both termini of the fragment (i,j)
4003 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4004 & (shield_mode.gt.0)) then
4006 do ilist=1,ishield_list(i)
4007 iresshield=shield_list(ilist,i)
4009 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
4011 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4013 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
4014 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4015 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4016 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4017 C if (iresshield.gt.i) then
4018 C do ishi=i+1,iresshield-1
4019 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4020 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4024 C do ishi=iresshield,i
4025 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4026 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
4032 do ilist=1,ishield_list(j)
4033 iresshield=shield_list(ilist,j)
4035 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
4037 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
4039 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
4040 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
4042 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4043 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
4044 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4045 C if (iresshield.gt.j) then
4046 C do ishi=j+1,iresshield-1
4047 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
4048 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4052 C do ishi=iresshield,j
4053 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
4054 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
4061 gshieldc(k,i)=gshieldc(k,i)+
4062 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4063 gshieldc(k,j)=gshieldc(k,j)+
4064 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4065 gshieldc(k,i-1)=gshieldc(k,i-1)+
4066 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
4067 gshieldc(k,j-1)=gshieldc(k,j-1)+
4068 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
4073 c ghalf=0.5D0*ggg(k)
4074 c gelc(k,i)=gelc(k,i)+ghalf
4075 c gelc(k,j)=gelc(k,j)+ghalf
4077 c 9/28/08 AL Gradient compotents will be summed only at the end
4078 C print *,"before", gelc_long(1,i), gelc_long(1,j)
4080 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4081 C & +grad_shield(k,j)*eesij/fac_shield(j)
4082 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4083 C & +grad_shield(k,i)*eesij/fac_shield(i)
4084 C gelc_long(k,i-1)=gelc_long(k,i-1)
4085 C & +grad_shield(k,i)*eesij/fac_shield(i)
4086 C gelc_long(k,j-1)=gelc_long(k,j-1)
4087 C & +grad_shield(k,j)*eesij/fac_shield(j)
4089 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
4092 * Loop over residues i+1 thru j-1.
4096 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4099 if (sss.gt.0.0) then
4100 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4101 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4102 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4109 c ghalf=0.5D0*ggg(k)
4110 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
4111 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
4113 c 9/28/08 AL Gradient compotents will be summed only at the end
4115 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4116 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4119 * Loop over residues i+1 thru j-1.
4123 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
4129 facvdw=(ev1+evdwij)*sss
4132 fac=-3*rrmij*(facvdw+facvdw+facel)
4137 * Radial derivatives. First process both termini of the fragment (i,j)
4141 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
4143 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
4145 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
4147 c ghalf=0.5D0*ggg(k)
4148 c gelc(k,i)=gelc(k,i)+ghalf
4149 c gelc(k,j)=gelc(k,j)+ghalf
4151 c 9/28/08 AL Gradient compotents will be summed only at the end
4153 gelc_long(k,j)=gelc(k,j)+ggg(k)
4154 gelc_long(k,i)=gelc(k,i)-ggg(k)
4157 * Loop over residues i+1 thru j-1.
4161 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4164 c 9/28/08 AL Gradient compotents will be summed only at the end
4165 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
4166 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
4167 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
4169 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4170 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4178 ecosa=2.0D0*fac3*fac1+fac4
4181 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4182 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4184 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4185 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4187 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4188 cd & (dcosg(k),k=1,3)
4190 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
4191 & fac_shield(i)**2*fac_shield(j)**2
4194 c ghalf=0.5D0*ggg(k)
4195 c gelc(k,i)=gelc(k,i)+ghalf
4196 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4197 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4198 c gelc(k,j)=gelc(k,j)+ghalf
4199 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4200 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4204 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4207 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
4210 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4211 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
4212 & *fac_shield(i)**2*fac_shield(j)**2
4214 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4215 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
4216 & *fac_shield(i)**2*fac_shield(j)**2
4217 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4218 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4220 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
4225 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4226 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
4227 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4229 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4230 C energy of a peptide unit is assumed in the form of a second-order
4231 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4232 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4233 C are computed for EVERY pair of non-contiguous peptide groups.
4236 if (j.lt.nres-1) then
4248 muij(kkk)=mu(k,i)*mu(l,j)
4249 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
4252 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4253 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4254 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4255 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4256 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4257 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4263 write (iout,*) 'EELEC: i',i,' j',j
4264 write (iout,*) 'j',j,' j1',j1,' j2',j2
4265 write(iout,*) 'muij',muij
4266 write (iout,*) "uy",uy(:,i)
4267 write (iout,*) "uz",uz(:,j)
4268 write (iout,*) "erij",erij
4270 ury=scalar(uy(1,i),erij)
4271 urz=scalar(uz(1,i),erij)
4272 vry=scalar(uy(1,j),erij)
4273 vrz=scalar(uz(1,j),erij)
4274 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4275 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4276 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4277 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4278 fac=dsqrt(-ael6i)*r3ij
4283 cd write (iout,'(4i5,4f10.5)')
4284 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
4285 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4286 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4287 cd & uy(:,j),uz(:,j)
4288 cd write (iout,'(4f10.5)')
4289 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4290 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4291 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
4292 cd write (iout,'(9f10.5/)')
4293 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4294 C Derivatives of the elements of A in virtual-bond vectors
4296 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4298 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4299 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4300 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4301 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4302 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4303 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4304 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4305 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4306 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4307 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4308 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4309 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4311 C Compute radial contributions to the gradient
4329 C Add the contributions coming from er
4332 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4333 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4334 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4335 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4338 C Derivatives in DC(i)
4339 cgrad ghalf1=0.5d0*agg(k,1)
4340 cgrad ghalf2=0.5d0*agg(k,2)
4341 cgrad ghalf3=0.5d0*agg(k,3)
4342 cgrad ghalf4=0.5d0*agg(k,4)
4343 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
4344 & -3.0d0*uryg(k,2)*vry)!+ghalf1
4345 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
4346 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
4347 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
4348 & -3.0d0*urzg(k,2)*vry)!+ghalf3
4349 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
4350 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
4351 C Derivatives in DC(i+1)
4352 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
4353 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4354 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
4355 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4356 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
4357 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4358 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
4359 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4360 C Derivatives in DC(j)
4361 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
4362 & -3.0d0*vryg(k,2)*ury)!+ghalf1
4363 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
4364 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
4365 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
4366 & -3.0d0*vryg(k,2)*urz)!+ghalf3
4367 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
4368 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
4369 C Derivatives in DC(j+1) or DC(nres-1)
4370 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
4371 & -3.0d0*vryg(k,3)*ury)
4372 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
4373 & -3.0d0*vrzg(k,3)*ury)
4374 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
4375 & -3.0d0*vryg(k,3)*urz)
4376 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
4377 & -3.0d0*vrzg(k,3)*urz)
4378 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
4380 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4395 aggi(k,l)=-aggi(k,l)
4396 aggi1(k,l)=-aggi1(k,l)
4397 aggj(k,l)=-aggj(k,l)
4398 aggj1(k,l)=-aggj1(k,l)
4402 if (j.lt.nres-1) then
4408 aggi(k,l)=-aggi(k,l)
4409 aggi1(k,l)=-aggi1(k,l)
4410 aggj(k,l)=-aggj(k,l)
4411 aggj1(k,l)=-aggj1(k,l)
4422 aggi(k,l)=-aggi(k,l)
4423 aggi1(k,l)=-aggi1(k,l)
4424 aggj(k,l)=-aggj(k,l)
4425 aggj1(k,l)=-aggj1(k,l)
4430 IF (wel_loc.gt.0.0d0) THEN
4431 C Contribution to the local-electrostatic energy coming from the i-j pair
4432 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4435 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
4437 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
4438 & " wel_loc",wel_loc
4440 if (shield_mode.eq.0) then
4447 eel_loc_ij=eel_loc_ij
4448 & *fac_shield(i)*fac_shield(j)
4449 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4450 & 'eelloc',i,j,eel_loc_ij
4451 c if (eel_loc_ij.ne.0)
4452 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4453 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4455 eel_loc=eel_loc+eel_loc_ij
4456 C Now derivative over eel_loc
4458 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4459 & (shield_mode.gt.0)) then
4462 do ilist=1,ishield_list(i)
4463 iresshield=shield_list(ilist,i)
4465 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
4468 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4470 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
4471 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4475 do ilist=1,ishield_list(j)
4476 iresshield=shield_list(ilist,j)
4478 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
4481 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
4483 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
4484 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
4491 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
4492 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4493 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
4494 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4495 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
4496 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
4497 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
4498 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
4503 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4504 c & ' eel_loc_ij',eel_loc_ij
4505 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
4506 C Calculate patrial derivative for theta angle
4508 geel_loc_ij=(a22*gmuij1(1)
4512 & *fac_shield(i)*fac_shield(j)
4513 c write(iout,*) "derivative over thatai"
4514 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4516 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4517 & geel_loc_ij*wel_loc
4518 c write(iout,*) "derivative over thatai-1"
4519 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4526 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4527 & geel_loc_ij*wel_loc
4528 & *fac_shield(i)*fac_shield(j)
4530 c Derivative over j residue
4531 geel_loc_ji=a22*gmuji1(1)
4535 c write(iout,*) "derivative over thataj"
4536 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4539 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4540 & geel_loc_ji*wel_loc
4541 & *fac_shield(i)*fac_shield(j)
4548 c write(iout,*) "derivative over thataj-1"
4549 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4551 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4552 & geel_loc_ji*wel_loc
4553 & *fac_shield(i)*fac_shield(j)
4555 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4557 C Partial derivatives in virtual-bond dihedral angles gamma
4559 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4560 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4561 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
4562 & *fac_shield(i)*fac_shield(j)
4564 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4565 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4566 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
4567 & *fac_shield(i)*fac_shield(j)
4568 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4570 ggg(l)=(agg(l,1)*muij(1)+
4571 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
4572 & *fac_shield(i)*fac_shield(j)
4573 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4574 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4575 cgrad ghalf=0.5d0*ggg(l)
4576 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4577 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4581 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4584 C Remaining derivatives of eello
4586 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4587 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4588 & *fac_shield(i)*fac_shield(j)
4590 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4591 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4592 & *fac_shield(i)*fac_shield(j)
4594 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4595 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4596 & *fac_shield(i)*fac_shield(j)
4598 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4599 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4600 & *fac_shield(i)*fac_shield(j)
4607 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4608 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4609 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4610 & .and. num_conti.le.maxconts) then
4611 c write (iout,*) i,j," entered corr"
4613 C Calculate the contact function. The ith column of the array JCONT will
4614 C contain the numbers of atoms that make contacts with the atom I (of numbers
4615 C greater than I). The arrays FACONT and GACONT will contain the values of
4616 C the contact function and its derivative.
4617 c r0ij=1.02D0*rpp(iteli,itelj)
4618 c r0ij=1.11D0*rpp(iteli,itelj)
4619 r0ij=2.20D0*rpp(iteli,itelj)
4620 c r0ij=1.55D0*rpp(iteli,itelj)
4621 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4622 if (fcont.gt.0.0D0) then
4623 num_conti=num_conti+1
4624 if (num_conti.gt.maxconts) then
4625 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4626 & ' will skip next contacts for this conf.'
4628 jcont_hb(num_conti,i)=j
4629 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4630 cd & " jcont_hb",jcont_hb(num_conti,i)
4631 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4632 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4633 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4635 d_cont(num_conti,i)=rij
4636 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4637 C --- Electrostatic-interaction matrix ---
4638 a_chuj(1,1,num_conti,i)=a22
4639 a_chuj(1,2,num_conti,i)=a23
4640 a_chuj(2,1,num_conti,i)=a32
4641 a_chuj(2,2,num_conti,i)=a33
4642 C --- Gradient of rij
4645 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4652 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4653 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4654 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4655 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4656 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4662 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4663 C Calculate contact energies
4665 wij=cosa-3.0D0*cosb*cosg
4668 c fac3=dsqrt(-ael6i)/r0ij**3
4669 fac3=dsqrt(-ael6i)*r3ij
4670 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4671 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4672 if (ees0tmp.gt.0) then
4673 ees0pij=dsqrt(ees0tmp)
4677 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4678 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4679 if (ees0tmp.gt.0) then
4680 ees0mij=dsqrt(ees0tmp)
4685 if (shield_mode.eq.0) then
4689 ees0plist(num_conti,i)=j
4690 C fac_shield(i)=0.4d0
4691 C fac_shield(j)=0.6d0
4693 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4694 & *fac_shield(i)*fac_shield(j)
4695 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4696 & *fac_shield(i)*fac_shield(j)
4697 C Diagnostics. Comment out or remove after debugging!
4698 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4699 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4700 c ees0m(num_conti,i)=0.0D0
4702 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4703 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4704 C Angular derivatives of the contact function
4706 ees0pij1=fac3/ees0pij
4707 ees0mij1=fac3/ees0mij
4708 fac3p=-3.0D0*fac3*rrmij
4709 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4710 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4712 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4713 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4714 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4715 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4716 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4717 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4718 ecosap=ecosa1+ecosa2
4719 ecosbp=ecosb1+ecosb2
4720 ecosgp=ecosg1+ecosg2
4721 ecosam=ecosa1-ecosa2
4722 ecosbm=ecosb1-ecosb2
4723 ecosgm=ecosg1-ecosg2
4732 facont_hb(num_conti,i)=fcont
4735 fprimcont=fprimcont/rij
4736 cd facont_hb(num_conti,i)=1.0D0
4737 C Following line is for diagnostics.
4740 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4741 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4744 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4745 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4747 gggp(1)=gggp(1)+ees0pijp*xj
4748 gggp(2)=gggp(2)+ees0pijp*yj
4749 gggp(3)=gggp(3)+ees0pijp*zj
4750 gggm(1)=gggm(1)+ees0mijp*xj
4751 gggm(2)=gggm(2)+ees0mijp*yj
4752 gggm(3)=gggm(3)+ees0mijp*zj
4753 C Derivatives due to the contact function
4754 gacont_hbr(1,num_conti,i)=fprimcont*xj
4755 gacont_hbr(2,num_conti,i)=fprimcont*yj
4756 gacont_hbr(3,num_conti,i)=fprimcont*zj
4759 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4760 c following the change of gradient-summation algorithm.
4762 cgrad ghalfp=0.5D0*gggp(k)
4763 cgrad ghalfm=0.5D0*gggm(k)
4764 gacontp_hb1(k,num_conti,i)=!ghalfp
4765 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4766 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4767 & *fac_shield(i)*fac_shield(j)
4769 gacontp_hb2(k,num_conti,i)=!ghalfp
4770 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4771 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4772 & *fac_shield(i)*fac_shield(j)
4774 gacontp_hb3(k,num_conti,i)=gggp(k)
4775 & *fac_shield(i)*fac_shield(j)
4777 gacontm_hb1(k,num_conti,i)=!ghalfm
4778 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4779 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4780 & *fac_shield(i)*fac_shield(j)
4782 gacontm_hb2(k,num_conti,i)=!ghalfm
4783 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4784 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4785 & *fac_shield(i)*fac_shield(j)
4787 gacontm_hb3(k,num_conti,i)=gggm(k)
4788 & *fac_shield(i)*fac_shield(j)
4791 C Diagnostics. Comment out or remove after debugging!
4793 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4794 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4795 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4796 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4797 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4798 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4804 endif ! num_conti.le.maxconts
4808 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4811 ghalf=0.5d0*agg(l,k)
4812 aggi(l,k)=aggi(l,k)+ghalf
4813 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4814 aggj(l,k)=aggj(l,k)+ghalf
4817 if (j.eq.nres-1 .and. i.lt.j-2) then
4820 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4826 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4829 C-----------------------------------------------------------------------------
4830 subroutine eturn3(i,eello_turn3)
4831 C Third- and fourth-order contributions from turns
4832 implicit real*8 (a-h,o-z)
4833 include 'DIMENSIONS'
4834 include 'DIMENSIONS.ZSCOPT'
4835 include 'COMMON.IOUNITS'
4836 include 'COMMON.GEO'
4837 include 'COMMON.VAR'
4838 include 'COMMON.LOCAL'
4839 include 'COMMON.CHAIN'
4840 include 'COMMON.DERIV'
4841 include 'COMMON.INTERACT'
4842 include 'COMMON.CONTACTS'
4843 include 'COMMON.TORSION'
4844 include 'COMMON.VECTORS'
4845 include 'COMMON.FFIELD'
4846 include 'COMMON.CONTROL'
4847 include 'COMMON.SHIELD'
4849 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4850 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4851 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4852 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4853 & auxgmat2(2,2),auxgmatt2(2,2)
4854 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4855 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4856 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4857 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4860 c write (iout,*) "eturn3",i,j,j1,j2
4865 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4867 C Third-order contributions
4874 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4875 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4876 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4877 c auxalary matices for theta gradient
4878 c auxalary matrix for i+1 and constant i+2
4879 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4880 c auxalary matrix for i+2 and constant i+1
4881 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4882 call transpose2(auxmat(1,1),auxmat1(1,1))
4883 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4884 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4885 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4886 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4887 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4888 if (shield_mode.eq.0) then
4895 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4896 & *fac_shield(i)*fac_shield(j)
4897 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
4898 & *fac_shield(i)*fac_shield(j)
4899 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
4903 C Derivatives in theta
4904 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4905 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4906 & *fac_shield(i)*fac_shield(j)
4907 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4908 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4909 & *fac_shield(i)*fac_shield(j)
4912 C Derivatives in shield mode
4913 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
4914 & (shield_mode.gt.0)) then
4917 do ilist=1,ishield_list(i)
4918 iresshield=shield_list(ilist,i)
4920 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4922 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4924 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4925 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4929 do ilist=1,ishield_list(j)
4930 iresshield=shield_list(ilist,j)
4932 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4934 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
4936 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4937 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
4944 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
4945 & grad_shield(k,i)*eello_t3/fac_shield(i)
4946 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
4947 & grad_shield(k,j)*eello_t3/fac_shield(j)
4948 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
4949 & grad_shield(k,i)*eello_t3/fac_shield(i)
4950 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
4951 & grad_shield(k,j)*eello_t3/fac_shield(j)
4955 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4956 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4957 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4958 cd & ' eello_turn3_num',4*eello_turn3_num
4959 C Derivatives in gamma(i)
4960 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4961 call transpose2(auxmat2(1,1),auxmat3(1,1))
4962 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4963 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4964 & *fac_shield(i)*fac_shield(j)
4965 C Derivatives in gamma(i+1)
4966 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4967 call transpose2(auxmat2(1,1),auxmat3(1,1))
4968 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4969 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4970 & +0.5d0*(pizda(1,1)+pizda(2,2))
4971 & *fac_shield(i)*fac_shield(j)
4972 C Cartesian derivatives
4974 c ghalf1=0.5d0*agg(l,1)
4975 c ghalf2=0.5d0*agg(l,2)
4976 c ghalf3=0.5d0*agg(l,3)
4977 c ghalf4=0.5d0*agg(l,4)
4978 a_temp(1,1)=aggi(l,1)!+ghalf1
4979 a_temp(1,2)=aggi(l,2)!+ghalf2
4980 a_temp(2,1)=aggi(l,3)!+ghalf3
4981 a_temp(2,2)=aggi(l,4)!+ghalf4
4982 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4983 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4984 & +0.5d0*(pizda(1,1)+pizda(2,2))
4985 & *fac_shield(i)*fac_shield(j)
4987 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4988 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4989 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4990 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4991 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4992 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4993 & +0.5d0*(pizda(1,1)+pizda(2,2))
4994 & *fac_shield(i)*fac_shield(j)
4995 a_temp(1,1)=aggj(l,1)!+ghalf1
4996 a_temp(1,2)=aggj(l,2)!+ghalf2
4997 a_temp(2,1)=aggj(l,3)!+ghalf3
4998 a_temp(2,2)=aggj(l,4)!+ghalf4
4999 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5000 gcorr3_turn(l,j)=gcorr3_turn(l,j)
5001 & +0.5d0*(pizda(1,1)+pizda(2,2))
5002 & *fac_shield(i)*fac_shield(j)
5003 a_temp(1,1)=aggj1(l,1)
5004 a_temp(1,2)=aggj1(l,2)
5005 a_temp(2,1)=aggj1(l,3)
5006 a_temp(2,2)=aggj1(l,4)
5007 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5008 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
5009 & +0.5d0*(pizda(1,1)+pizda(2,2))
5010 & *fac_shield(i)*fac_shield(j)
5017 C-------------------------------------------------------------------------------
5018 subroutine eturn4(i,eello_turn4)
5019 C Third- and fourth-order contributions from turns
5020 implicit real*8 (a-h,o-z)
5021 include 'DIMENSIONS'
5022 include 'DIMENSIONS.ZSCOPT'
5023 include 'COMMON.IOUNITS'
5024 include 'COMMON.GEO'
5025 include 'COMMON.VAR'
5026 include 'COMMON.LOCAL'
5027 include 'COMMON.CHAIN'
5028 include 'COMMON.DERIV'
5029 include 'COMMON.INTERACT'
5030 include 'COMMON.CONTACTS'
5031 include 'COMMON.TORSION'
5032 include 'COMMON.VECTORS'
5033 include 'COMMON.FFIELD'
5034 include 'COMMON.CONTROL'
5035 include 'COMMON.SHIELD'
5037 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5038 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5039 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
5040 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
5041 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
5042 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
5043 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
5044 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5045 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5046 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5047 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5050 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5052 C Fourth-order contributions
5060 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5061 cd call checkint_turn4(i,a_temp,eello_turn4_num)
5062 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5063 c write(iout,*)"WCHODZE W PROGRAM"
5068 iti1=itype2loc(itype(i+1))
5069 iti2=itype2loc(itype(i+2))
5070 iti3=itype2loc(itype(i+3))
5071 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5072 call transpose2(EUg(1,1,i+1),e1t(1,1))
5073 call transpose2(Eug(1,1,i+2),e2t(1,1))
5074 call transpose2(Eug(1,1,i+3),e3t(1,1))
5075 C Ematrix derivative in theta
5076 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
5077 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
5078 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
5079 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5080 c eta1 in derivative theta
5081 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
5082 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5083 c auxgvec is derivative of Ub2 so i+3 theta
5084 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
5085 c auxalary matrix of E i+1
5086 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
5089 s1=scalar2(b1(1,i+2),auxvec(1))
5090 c derivative of theta i+2 with constant i+3
5091 gs23=scalar2(gtb1(1,i+2),auxvec(1))
5092 c derivative of theta i+2 with constant i+2
5093 gs32=scalar2(b1(1,i+2),auxgvec(1))
5094 c derivative of E matix in theta of i+1
5095 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
5097 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5098 c ea31 in derivative theta
5099 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
5100 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5101 c auxilary matrix auxgvec of Ub2 with constant E matirx
5102 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
5103 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
5104 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
5108 s2=scalar2(b1(1,i+1),auxvec(1))
5109 c derivative of theta i+1 with constant i+3
5110 gs13=scalar2(gtb1(1,i+1),auxvec(1))
5111 c derivative of theta i+2 with constant i+1
5112 gs21=scalar2(b1(1,i+1),auxgvec(1))
5113 c derivative of theta i+3 with constant i+1
5114 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
5115 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
5117 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5118 c two derivatives over diffetent matrices
5119 c gtae3e2 is derivative over i+3
5120 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
5121 c ae3gte2 is derivative over i+2
5122 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5123 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5124 c three possible derivative over theta E matices
5126 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5128 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5130 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5131 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5133 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5134 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5135 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5136 if (shield_mode.eq.0) then
5143 eello_turn4=eello_turn4-(s1+s2+s3)
5144 & *fac_shield(i)*fac_shield(j)
5145 eello_t4=-(s1+s2+s3)
5146 & *fac_shield(i)*fac_shield(j)
5147 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
5148 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
5149 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
5150 C Now derivative over shield:
5151 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
5152 & (shield_mode.gt.0)) then
5155 do ilist=1,ishield_list(i)
5156 iresshield=shield_list(ilist,i)
5158 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5160 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5162 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5163 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5167 do ilist=1,ishield_list(j)
5168 iresshield=shield_list(ilist,j)
5170 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5172 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
5174 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5175 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
5182 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
5183 & grad_shield(k,i)*eello_t4/fac_shield(i)
5184 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
5185 & grad_shield(k,j)*eello_t4/fac_shield(j)
5186 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
5187 & grad_shield(k,i)*eello_t4/fac_shield(i)
5188 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
5189 & grad_shield(k,j)*eello_t4/fac_shield(j)
5192 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5193 cd & ' eello_turn4_num',8*eello_turn4_num
5195 gloc(nphi+i,icg)=gloc(nphi+i,icg)
5196 & -(gs13+gsE13+gsEE1)*wturn4
5197 & *fac_shield(i)*fac_shield(j)
5198 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
5199 & -(gs23+gs21+gsEE2)*wturn4
5200 & *fac_shield(i)*fac_shield(j)
5202 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
5203 & -(gs32+gsE31+gsEE3)*wturn4
5204 & *fac_shield(i)*fac_shield(j)
5206 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5209 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5210 & 'eturn4',i,j,-(s1+s2+s3)
5211 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5212 c & ' eello_turn4_num',8*eello_turn4_num
5213 C Derivatives in gamma(i)
5214 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5215 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5216 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5217 s1=scalar2(b1(1,i+2),auxvec(1))
5218 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5219 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5220 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5221 & *fac_shield(i)*fac_shield(j)
5222 C Derivatives in gamma(i+1)
5223 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5224 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5225 s2=scalar2(b1(1,i+1),auxvec(1))
5226 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5227 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5228 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5229 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5230 & *fac_shield(i)*fac_shield(j)
5231 C Derivatives in gamma(i+2)
5232 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5233 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5234 s1=scalar2(b1(1,i+2),auxvec(1))
5235 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5236 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5237 s2=scalar2(b1(1,i+1),auxvec(1))
5238 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5239 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5240 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5241 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5242 & *fac_shield(i)*fac_shield(j)
5244 C Cartesian derivatives
5245 C Derivatives of this turn contributions in DC(i+2)
5246 if (j.lt.nres-1) then
5248 a_temp(1,1)=agg(l,1)
5249 a_temp(1,2)=agg(l,2)
5250 a_temp(2,1)=agg(l,3)
5251 a_temp(2,2)=agg(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))
5262 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5263 & *fac_shield(i)*fac_shield(j)
5266 C Remaining derivatives of this turn contribution
5268 a_temp(1,1)=aggi(l,1)
5269 a_temp(1,2)=aggi(l,2)
5270 a_temp(2,1)=aggi(l,3)
5271 a_temp(2,2)=aggi(l,4)
5272 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5273 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5274 s1=scalar2(b1(1,i+2),auxvec(1))
5275 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5276 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5277 s2=scalar2(b1(1,i+1),auxvec(1))
5278 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5279 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5280 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5281 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5282 & *fac_shield(i)*fac_shield(j)
5283 a_temp(1,1)=aggi1(l,1)
5284 a_temp(1,2)=aggi1(l,2)
5285 a_temp(2,1)=aggi1(l,3)
5286 a_temp(2,2)=aggi1(l,4)
5287 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5288 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5289 s1=scalar2(b1(1,i+2),auxvec(1))
5290 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5291 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5292 s2=scalar2(b1(1,i+1),auxvec(1))
5293 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5294 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5295 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5296 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5297 & *fac_shield(i)*fac_shield(j)
5298 a_temp(1,1)=aggj(l,1)
5299 a_temp(1,2)=aggj(l,2)
5300 a_temp(2,1)=aggj(l,3)
5301 a_temp(2,2)=aggj(l,4)
5302 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5303 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5304 s1=scalar2(b1(1,i+2),auxvec(1))
5305 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5306 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5307 s2=scalar2(b1(1,i+1),auxvec(1))
5308 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5309 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5310 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5311 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5312 & *fac_shield(i)*fac_shield(j)
5313 a_temp(1,1)=aggj1(l,1)
5314 a_temp(1,2)=aggj1(l,2)
5315 a_temp(2,1)=aggj1(l,3)
5316 a_temp(2,2)=aggj1(l,4)
5317 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5318 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5319 s1=scalar2(b1(1,i+2),auxvec(1))
5320 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5321 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5322 s2=scalar2(b1(1,i+1),auxvec(1))
5323 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5324 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5325 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5326 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5327 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5328 & *fac_shield(i)*fac_shield(j)
5335 C-----------------------------------------------------------------------------
5336 subroutine vecpr(u,v,w)
5337 implicit real*8(a-h,o-z)
5338 dimension u(3),v(3),w(3)
5339 w(1)=u(2)*v(3)-u(3)*v(2)
5340 w(2)=-u(1)*v(3)+u(3)*v(1)
5341 w(3)=u(1)*v(2)-u(2)*v(1)
5344 C-----------------------------------------------------------------------------
5345 subroutine unormderiv(u,ugrad,unorm,ungrad)
5346 C This subroutine computes the derivatives of a normalized vector u, given
5347 C the derivatives computed without normalization conditions, ugrad. Returns
5350 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5351 double precision vec(3)
5352 double precision scalar
5354 c write (2,*) 'ugrad',ugrad
5357 vec(i)=scalar(ugrad(1,i),u(1))
5359 c write (2,*) 'vec',vec
5362 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5365 c write (2,*) 'ungrad',ungrad
5368 C-----------------------------------------------------------------------------
5369 subroutine escp(evdw2,evdw2_14)
5371 C This subroutine calculates the excluded-volume interaction energy between
5372 C peptide-group centers and side chains and its gradient in virtual-bond and
5373 C side-chain vectors.
5375 implicit real*8 (a-h,o-z)
5376 include 'DIMENSIONS'
5377 include 'DIMENSIONS.ZSCOPT'
5378 include 'COMMON.GEO'
5379 include 'COMMON.VAR'
5380 include 'COMMON.LOCAL'
5381 include 'COMMON.CHAIN'
5382 include 'COMMON.DERIV'
5383 include 'COMMON.INTERACT'
5384 include 'COMMON.FFIELD'
5385 include 'COMMON.IOUNITS'
5389 cd print '(a)','Enter ESCP'
5390 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
5391 c & ' scal14',scal14
5392 do i=iatscp_s,iatscp_e
5393 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5395 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
5396 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
5397 if (iteli.eq.0) goto 1225
5398 xi=0.5D0*(c(1,i)+c(1,i+1))
5399 yi=0.5D0*(c(2,i)+c(2,i+1))
5400 zi=0.5D0*(c(3,i)+c(3,i+1))
5401 C Returning the ith atom to box
5403 if (xi.lt.0) xi=xi+boxxsize
5405 if (yi.lt.0) yi=yi+boxysize
5407 if (zi.lt.0) zi=zi+boxzsize
5408 do iint=1,nscp_gr(i)
5410 do j=iscpstart(i,iint),iscpend(i,iint)
5411 itypj=iabs(itype(j))
5412 if (itypj.eq.ntyp1) cycle
5413 C Uncomment following three lines for SC-p interactions
5417 C Uncomment following three lines for Ca-p interactions
5421 C returning the jth atom to box
5423 if (xj.lt.0) xj=xj+boxxsize
5425 if (yj.lt.0) yj=yj+boxysize
5427 if (zj.lt.0) zj=zj+boxzsize
5428 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5433 C Finding the closest jth atom
5437 xj=xj_safe+xshift*boxxsize
5438 yj=yj_safe+yshift*boxysize
5439 zj=zj_safe+zshift*boxzsize
5440 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5441 if(dist_temp.lt.dist_init) then
5451 if (subchap.eq.1) then
5460 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5461 C sss is scaling function for smoothing the cutoff gradient otherwise
5462 C the gradient would not be continuouse
5463 sss=sscale(1.0d0/(dsqrt(rrij)))
5464 if (sss.le.0.0d0) cycle
5465 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5467 e1=fac*fac*aad(itypj,iteli)
5468 e2=fac*bad(itypj,iteli)
5469 if (iabs(j-i) .le. 2) then
5472 evdw2_14=evdw2_14+(e1+e2)*sss
5475 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5476 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5477 c & bad(itypj,iteli)
5478 evdw2=evdw2+evdwij*sss
5481 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5483 fac=-(evdwij+e1)*rrij*sss
5484 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5489 cd write (iout,*) 'j<i'
5490 C Uncomment following three lines for SC-p interactions
5492 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5495 cd write (iout,*) 'j>i'
5498 C Uncomment following line for SC-p interactions
5499 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5503 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5507 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5508 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5511 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5521 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5522 gradx_scp(j,i)=expon*gradx_scp(j,i)
5525 C******************************************************************************
5529 C To save time the factor EXPON has been extracted from ALL components
5530 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5533 C******************************************************************************
5536 C--------------------------------------------------------------------------
5537 subroutine edis(ehpb)
5539 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5541 implicit real*8 (a-h,o-z)
5542 include 'DIMENSIONS'
5543 include 'DIMENSIONS.ZSCOPT'
5544 include 'COMMON.SBRIDGE'
5545 include 'COMMON.CHAIN'
5546 include 'COMMON.DERIV'
5547 include 'COMMON.VAR'
5548 include 'COMMON.INTERACT'
5549 include 'COMMON.CONTROL'
5550 include 'COMMON.IOUNITS'
5553 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
5554 cd print *,'link_start=',link_start,' link_end=',link_end
5555 C write(iout,*) link_end, "link_end"
5556 if (link_end.eq.0) return
5557 do i=link_start,link_end
5558 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5559 C CA-CA distance used in regularization of structure.
5562 C iii and jjj point to the residues for which the distance is assigned.
5563 if (ii.gt.nres) then
5570 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5571 C distance and angle dependent SS bond potential.
5572 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5573 C & iabs(itype(jjj)).eq.1) then
5574 C write(iout,*) constr_dist,"const"
5575 if (.not.dyn_ss .and. i.le.nss) then
5576 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5577 & iabs(itype(jjj)).eq.1) then
5578 call ssbond_ene(iii,jjj,eij)
5581 else if (ii.gt.nres .and. jj.gt.nres) then
5582 c Restraints from contact prediction
5584 if (constr_dist.eq.11) then
5585 C ehpb=ehpb+fordepth(i)**4.0d0
5586 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5587 ehpb=ehpb+fordepth(i)**4.0d0
5588 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5589 fac=fordepth(i)**4.0d0
5590 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5591 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5592 C & ehpb,fordepth(i),dd
5593 C write(iout,*) ehpb,"atu?"
5595 C fac=fordepth(i)**4.0d0
5596 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5598 if (dhpb1(i).gt.0.0d0) then
5599 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5600 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5601 c write (iout,*) "beta nmr",
5602 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5606 C Get the force constant corresponding to this distance.
5608 C Calculate the contribution to energy.
5609 ehpb=ehpb+waga*rdis*rdis
5610 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5612 C Evaluate gradient.
5615 endif !end dhpb1(i).gt.0
5616 endif !end const_dist=11
5618 ggg(j)=fac*(c(j,jj)-c(j,ii))
5621 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5622 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5625 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5626 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5629 C write(iout,*) "before"
5631 C write(iout,*) "after",dd
5632 if (constr_dist.eq.11) then
5633 ehpb=ehpb+fordepth(i)**4.0d0
5634 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5635 fac=fordepth(i)**4.0d0
5636 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5637 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
5638 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
5639 C print *,ehpb,"tu?"
5640 C write(iout,*) ehpb,"btu?",
5641 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
5642 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5643 C & ehpb,fordepth(i),dd
5645 if (dhpb1(i).gt.0.0d0) then
5646 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5647 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5648 c write (iout,*) "alph nmr",
5649 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5652 C Get the force constant corresponding to this distance.
5654 C Calculate the contribution to energy.
5655 ehpb=ehpb+waga*rdis*rdis
5656 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5658 C Evaluate gradient.
5665 ggg(j)=fac*(c(j,jj)-c(j,ii))
5667 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5668 C If this is a SC-SC distance, we need to calculate the contributions to the
5669 C Cartesian gradient in the SC vectors (ghpbx).
5672 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5673 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5678 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5683 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5686 C--------------------------------------------------------------------------
5687 subroutine ssbond_ene(i,j,eij)
5689 C Calculate the distance and angle dependent SS-bond potential energy
5690 C using a free-energy function derived based on RHF/6-31G** ab initio
5691 C calculations of diethyl disulfide.
5693 C A. Liwo and U. Kozlowska, 11/24/03
5695 implicit real*8 (a-h,o-z)
5696 include 'DIMENSIONS'
5697 include 'DIMENSIONS.ZSCOPT'
5698 include 'COMMON.SBRIDGE'
5699 include 'COMMON.CHAIN'
5700 include 'COMMON.DERIV'
5701 include 'COMMON.LOCAL'
5702 include 'COMMON.INTERACT'
5703 include 'COMMON.VAR'
5704 include 'COMMON.IOUNITS'
5705 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5706 itypi=iabs(itype(i))
5710 dxi=dc_norm(1,nres+i)
5711 dyi=dc_norm(2,nres+i)
5712 dzi=dc_norm(3,nres+i)
5713 dsci_inv=dsc_inv(itypi)
5714 itypj=iabs(itype(j))
5715 dscj_inv=dsc_inv(itypj)
5719 dxj=dc_norm(1,nres+j)
5720 dyj=dc_norm(2,nres+j)
5721 dzj=dc_norm(3,nres+j)
5722 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5727 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5728 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5729 om12=dxi*dxj+dyi*dyj+dzi*dzj
5731 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5732 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5738 deltat12=om2-om1+2.0d0
5740 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5741 & +akct*deltad*deltat12
5742 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
5743 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5744 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5745 c & " deltat12",deltat12," eij",eij
5746 ed=2*akcm*deltad+akct*deltat12
5748 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5749 eom1=-2*akth*deltat1-pom1-om2*pom2
5750 eom2= 2*akth*deltat2+pom1-om1*pom2
5753 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5756 ghpbx(k,i)=ghpbx(k,i)-gg(k)
5757 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
5758 ghpbx(k,j)=ghpbx(k,j)+gg(k)
5759 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
5762 C Calculate the components of the gradient in DC and X
5766 ghpbc(l,k)=ghpbc(l,k)+gg(l)
5771 C--------------------------------------------------------------------------
5772 subroutine ebond(estr)
5774 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5776 implicit real*8 (a-h,o-z)
5777 include 'DIMENSIONS'
5778 include 'DIMENSIONS.ZSCOPT'
5779 include 'COMMON.LOCAL'
5780 include 'COMMON.GEO'
5781 include 'COMMON.INTERACT'
5782 include 'COMMON.DERIV'
5783 include 'COMMON.VAR'
5784 include 'COMMON.CHAIN'
5785 include 'COMMON.IOUNITS'
5786 include 'COMMON.NAMES'
5787 include 'COMMON.FFIELD'
5788 include 'COMMON.CONTROL'
5789 double precision u(3),ud(3)
5792 c write (iout,*) "distchainmax",distchainmax
5794 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5795 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5797 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5798 C & *dc(j,i-1)/vbld(i)
5800 C if (energy_dec) write(iout,*)
5801 C & "estr1",i,vbld(i),distchainmax,
5802 C & gnmr1(vbld(i),-1.0d0,distchainmax)
5804 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5805 diff = vbld(i)-vbldpDUM
5806 C write(iout,*) i,diff
5808 diff = vbld(i)-vbldp0
5809 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
5813 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5816 C write (iout,'(a7,i5,4f7.3)')
5817 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5819 estr=0.5d0*AKP*estr+estr1
5821 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5825 if (iti.ne.10 .and. iti.ne.ntyp1) then
5828 diff=vbld(i+nres)-vbldsc0(1,iti)
5829 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5830 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
5831 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5833 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5837 diff=vbld(i+nres)-vbldsc0(j,iti)
5838 ud(j)=aksc(j,iti)*diff
5839 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5853 uprod2=uprod2*u(k)*u(k)
5857 usumsqder=usumsqder+ud(j)*uprod2
5859 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
5860 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
5861 estr=estr+uprod/usum
5863 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5871 C--------------------------------------------------------------------------
5872 subroutine ebend(etheta,ethetacnstr)
5874 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5875 C angles gamma and its derivatives in consecutive thetas and gammas.
5877 implicit real*8 (a-h,o-z)
5878 include 'DIMENSIONS'
5879 include 'DIMENSIONS.ZSCOPT'
5880 include 'COMMON.LOCAL'
5881 include 'COMMON.GEO'
5882 include 'COMMON.INTERACT'
5883 include 'COMMON.DERIV'
5884 include 'COMMON.VAR'
5885 include 'COMMON.CHAIN'
5886 include 'COMMON.IOUNITS'
5887 include 'COMMON.NAMES'
5888 include 'COMMON.FFIELD'
5889 include 'COMMON.TORCNSTR'
5890 common /calcthet/ term1,term2,termm,diffak,ratak,
5891 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5892 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5893 double precision y(2),z(2)
5895 c time11=dexp(-2*time)
5898 c write (iout,*) "nres",nres
5899 c write (*,'(a,i2)') 'EBEND ICG=',icg
5900 c write (iout,*) ithet_start,ithet_end
5901 do i=ithet_start,ithet_end
5902 C if (itype(i-1).eq.ntyp1) cycle
5904 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5905 & .or.itype(i).eq.ntyp1) cycle
5906 C Zero the energy function and its derivative at 0 or pi.
5907 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5909 ichir1=isign(1,itype(i-2))
5910 ichir2=isign(1,itype(i))
5911 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5912 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5913 if (itype(i-1).eq.10) then
5914 itype1=isign(10,itype(i-2))
5915 ichir11=isign(1,itype(i-2))
5916 ichir12=isign(1,itype(i-2))
5917 itype2=isign(10,itype(i))
5918 ichir21=isign(1,itype(i))
5919 ichir22=isign(1,itype(i))
5926 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5930 c call proc_proc(phii,icrc)
5931 if (icrc.eq.1) phii=150.0
5942 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5946 c call proc_proc(phii1,icrc)
5947 if (icrc.eq.1) phii1=150.0
5959 C Calculate the "mean" value of theta from the part of the distribution
5960 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5961 C In following comments this theta will be referred to as t_c.
5962 thet_pred_mean=0.0d0
5964 athetk=athet(k,it,ichir1,ichir2)
5965 bthetk=bthet(k,it,ichir1,ichir2)
5967 athetk=athet(k,itype1,ichir11,ichir12)
5968 bthetk=bthet(k,itype2,ichir21,ichir22)
5970 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5972 c write (iout,*) "thet_pred_mean",thet_pred_mean
5973 dthett=thet_pred_mean*ssd
5974 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5975 c write (iout,*) "thet_pred_mean",thet_pred_mean
5976 C Derivatives of the "mean" values in gamma1 and gamma2.
5977 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5978 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5979 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5980 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5982 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5983 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5984 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5985 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5987 if (theta(i).gt.pi-delta) then
5988 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5990 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5991 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5992 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5994 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5996 else if (theta(i).lt.delta) then
5997 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5998 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5999 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6001 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6002 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6005 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6008 etheta=etheta+ethetai
6009 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
6010 c & 'ebend',i,ethetai,theta(i),itype(i)
6011 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
6012 c & rad2deg*phii,rad2deg*phii1,ethetai
6013 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6014 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6015 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
6019 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6020 do i=1,ntheta_constr
6021 itheta=itheta_constr(i)
6022 thetiii=theta(itheta)
6023 difi=pinorm(thetiii-theta_constr0(i))
6024 if (difi.gt.theta_drange(i)) then
6025 difi=difi-theta_drange(i)
6026 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6027 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6028 & +for_thet_constr(i)*difi**3
6029 else if (difi.lt.-drange(i)) then
6031 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6032 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6033 & +for_thet_constr(i)*difi**3
6037 C if (energy_dec) then
6038 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6039 C & i,itheta,rad2deg*thetiii,
6040 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6041 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6042 C & gloc(itheta+nphi-2,icg)
6045 C Ufff.... We've done all this!!!
6048 C---------------------------------------------------------------------------
6049 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6051 implicit real*8 (a-h,o-z)
6052 include 'DIMENSIONS'
6053 include 'COMMON.LOCAL'
6054 include 'COMMON.IOUNITS'
6055 common /calcthet/ term1,term2,termm,diffak,ratak,
6056 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6057 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6058 C Calculate the contributions to both Gaussian lobes.
6059 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6060 C The "polynomial part" of the "standard deviation" of this part of
6064 sig=sig*thet_pred_mean+polthet(j,it)
6066 C Derivative of the "interior part" of the "standard deviation of the"
6067 C gamma-dependent Gaussian lobe in t_c.
6068 sigtc=3*polthet(3,it)
6070 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6073 C Set the parameters of both Gaussian lobes of the distribution.
6074 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6075 fac=sig*sig+sigc0(it)
6078 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6079 sigsqtc=-4.0D0*sigcsq*sigtc
6080 c print *,i,sig,sigtc,sigsqtc
6081 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6082 sigtc=-sigtc/(fac*fac)
6083 C Following variable is sigma(t_c)**(-2)
6084 sigcsq=sigcsq*sigcsq
6086 sig0inv=1.0D0/sig0i**2
6087 delthec=thetai-thet_pred_mean
6088 delthe0=thetai-theta0i
6089 term1=-0.5D0*sigcsq*delthec*delthec
6090 term2=-0.5D0*sig0inv*delthe0*delthe0
6091 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6092 C NaNs in taking the logarithm. We extract the largest exponent which is added
6093 C to the energy (this being the log of the distribution) at the end of energy
6094 C term evaluation for this virtual-bond angle.
6095 if (term1.gt.term2) then
6097 term2=dexp(term2-termm)
6101 term1=dexp(term1-termm)
6104 C The ratio between the gamma-independent and gamma-dependent lobes of
6105 C the distribution is a Gaussian function of thet_pred_mean too.
6106 diffak=gthet(2,it)-thet_pred_mean
6107 ratak=diffak/gthet(3,it)**2
6108 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6109 C Let's differentiate it in thet_pred_mean NOW.
6111 C Now put together the distribution terms to make complete distribution.
6112 termexp=term1+ak*term2
6113 termpre=sigc+ak*sig0i
6114 C Contribution of the bending energy from this theta is just the -log of
6115 C the sum of the contributions from the two lobes and the pre-exponential
6116 C factor. Simple enough, isn't it?
6117 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6118 C NOW the derivatives!!!
6119 C 6/6/97 Take into account the deformation.
6120 E_theta=(delthec*sigcsq*term1
6121 & +ak*delthe0*sig0inv*term2)/termexp
6122 E_tc=((sigtc+aktc*sig0i)/termpre
6123 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6124 & aktc*term2)/termexp)
6127 c-----------------------------------------------------------------------------
6128 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6129 implicit real*8 (a-h,o-z)
6130 include 'DIMENSIONS'
6131 include 'COMMON.LOCAL'
6132 include 'COMMON.IOUNITS'
6133 common /calcthet/ term1,term2,termm,diffak,ratak,
6134 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6135 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6136 delthec=thetai-thet_pred_mean
6137 delthe0=thetai-theta0i
6138 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6139 t3 = thetai-thet_pred_mean
6143 t14 = t12+t6*sigsqtc
6145 t21 = thetai-theta0i
6151 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6152 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6153 & *(-t12*t9-ak*sig0inv*t27)
6157 C--------------------------------------------------------------------------
6158 subroutine ebend(etheta)
6160 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6161 C angles gamma and its derivatives in consecutive thetas and gammas.
6162 C ab initio-derived potentials from
6163 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6165 implicit real*8 (a-h,o-z)
6166 include 'DIMENSIONS'
6167 include 'DIMENSIONS.ZSCOPT'
6168 include 'COMMON.LOCAL'
6169 include 'COMMON.GEO'
6170 include 'COMMON.INTERACT'
6171 include 'COMMON.DERIV'
6172 include 'COMMON.VAR'
6173 include 'COMMON.CHAIN'
6174 include 'COMMON.IOUNITS'
6175 include 'COMMON.NAMES'
6176 include 'COMMON.FFIELD'
6177 include 'COMMON.CONTROL'
6178 include 'COMMON.TORCNSTR'
6179 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6180 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6181 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6182 & sinph1ph2(maxdouble,maxdouble)
6183 logical lprn /.false./, lprn1 /.false./
6185 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
6186 do i=ithet_start,ithet_end
6188 C if (itype(i-1).eq.ntyp1) cycle
6190 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6191 & .or.itype(i).eq.ntyp1) cycle
6192 if (iabs(itype(i+1)).eq.20) iblock=2
6193 if (iabs(itype(i+1)).ne.20) iblock=1
6197 theti2=0.5d0*theta(i)
6198 ityp2=ithetyp((itype(i-1)))
6200 coskt(k)=dcos(k*theti2)
6201 sinkt(k)=dsin(k*theti2)
6211 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
6214 if (phii.ne.phii) phii=150.0
6218 ityp1=ithetyp((itype(i-2)))
6220 cosph1(k)=dcos(k*phii)
6221 sinph1(k)=dsin(k*phii)
6227 ityp1=ithetyp((itype(i-2)))
6233 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
6236 if (phii1.ne.phii1) phii1=150.0
6241 ityp3=ithetyp((itype(i)))
6243 cosph2(k)=dcos(k*phii1)
6244 sinph2(k)=dsin(k*phii1)
6249 ityp3=ithetyp((itype(i)))
6255 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
6256 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
6258 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6261 ccl=cosph1(l)*cosph2(k-l)
6262 ssl=sinph1(l)*sinph2(k-l)
6263 scl=sinph1(l)*cosph2(k-l)
6264 csl=cosph1(l)*sinph2(k-l)
6265 cosph1ph2(l,k)=ccl-ssl
6266 cosph1ph2(k,l)=ccl+ssl
6267 sinph1ph2(l,k)=scl+csl
6268 sinph1ph2(k,l)=scl-csl
6272 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6273 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6274 write (iout,*) "coskt and sinkt"
6276 write (iout,*) k,coskt(k),sinkt(k)
6280 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6281 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
6284 & write (iout,*) "k",k,"
6285 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
6286 & " ethetai",ethetai
6289 write (iout,*) "cosph and sinph"
6291 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6293 write (iout,*) "cosph1ph2 and sinph2ph2"
6296 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6297 & sinph1ph2(l,k),sinph1ph2(k,l)
6300 write(iout,*) "ethetai",ethetai
6304 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
6305 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
6306 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
6307 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6308 ethetai=ethetai+sinkt(m)*aux
6309 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6310 dephii=dephii+k*sinkt(m)*(
6311 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
6312 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6313 dephii1=dephii1+k*sinkt(m)*(
6314 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
6315 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6317 & write (iout,*) "m",m," k",k," bbthet",
6318 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
6319 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
6320 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
6321 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6325 & write(iout,*) "ethetai",ethetai
6329 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6330 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
6331 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6332 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6333 ethetai=ethetai+sinkt(m)*aux
6334 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6335 dephii=dephii+l*sinkt(m)*(
6336 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
6337 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6338 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
6339 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6340 dephii1=dephii1+(k-l)*sinkt(m)*(
6341 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
6342 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
6343 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
6344 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6346 write (iout,*) "m",m," k",k," l",l," ffthet",
6347 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6348 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
6349 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
6350 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
6351 & " ethetai",ethetai
6352 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6353 & cosph1ph2(k,l)*sinkt(m),
6354 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6360 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6361 & i,theta(i)*rad2deg,phii*rad2deg,
6362 & phii1*rad2deg,ethetai
6363 etheta=etheta+ethetai
6364 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6365 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6366 c gloc(nphi+i-2,icg)=wang*dethetai
6367 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
6373 c-----------------------------------------------------------------------------
6374 subroutine esc(escloc)
6375 C Calculate the local energy of a side chain and its derivatives in the
6376 C corresponding virtual-bond valence angles THETA and the spherical angles
6378 implicit real*8 (a-h,o-z)
6379 include 'DIMENSIONS'
6380 include 'DIMENSIONS.ZSCOPT'
6381 include 'COMMON.GEO'
6382 include 'COMMON.LOCAL'
6383 include 'COMMON.VAR'
6384 include 'COMMON.INTERACT'
6385 include 'COMMON.DERIV'
6386 include 'COMMON.CHAIN'
6387 include 'COMMON.IOUNITS'
6388 include 'COMMON.NAMES'
6389 include 'COMMON.FFIELD'
6390 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6391 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6392 common /sccalc/ time11,time12,time112,theti,it,nlobit
6395 C write (iout,*) 'ESC'
6396 do i=loc_start,loc_end
6398 if (it.eq.ntyp1) cycle
6399 if (it.eq.10) goto 1
6400 nlobit=nlob(iabs(it))
6401 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6402 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6403 theti=theta(i+1)-pipol
6407 c write (iout,*) "i",i," x",x(1),x(2),x(3)
6409 if (x(2).gt.pi-delta) then
6413 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6415 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6416 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6418 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6419 & ddersc0(1),dersc(1))
6420 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6421 & ddersc0(3),dersc(3))
6423 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6425 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6426 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6427 & dersc0(2),esclocbi,dersc02)
6428 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6430 call splinthet(x(2),0.5d0*delta,ss,ssd)
6435 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6437 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6438 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6440 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6442 c write (iout,*) escloci
6443 else if (x(2).lt.delta) then
6447 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6449 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6450 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6452 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6453 & ddersc0(1),dersc(1))
6454 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6455 & ddersc0(3),dersc(3))
6457 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6459 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6460 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6461 & dersc0(2),esclocbi,dersc02)
6462 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6467 call splinthet(x(2),0.5d0*delta,ss,ssd)
6469 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6471 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6472 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6474 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6475 C write (iout,*) 'i=',i, escloci
6477 call enesc(x,escloci,dersc,ddummy,.false.)
6480 escloc=escloc+escloci
6481 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6482 write (iout,'(a6,i5,0pf7.3)')
6483 & 'escloc',i,escloci
6485 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6487 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6488 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6493 C---------------------------------------------------------------------------
6494 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6495 implicit real*8 (a-h,o-z)
6496 include 'DIMENSIONS'
6497 include 'COMMON.GEO'
6498 include 'COMMON.LOCAL'
6499 include 'COMMON.IOUNITS'
6500 common /sccalc/ time11,time12,time112,theti,it,nlobit
6501 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6502 double precision contr(maxlob,-1:1)
6504 c write (iout,*) 'it=',it,' nlobit=',nlobit
6508 if (mixed) ddersc(j)=0.0d0
6512 C Because of periodicity of the dependence of the SC energy in omega we have
6513 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6514 C To avoid underflows, first compute & store the exponents.
6522 z(k)=x(k)-censc(k,j,it)
6527 Axk=Axk+gaussc(l,k,j,it)*z(l)
6533 expfac=expfac+Ax(k,j,iii)*z(k)
6541 C As in the case of ebend, we want to avoid underflows in exponentiation and
6542 C subsequent NaNs and INFs in energy calculation.
6543 C Find the largest exponent
6547 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6551 cd print *,'it=',it,' emin=',emin
6553 C Compute the contribution to SC energy and derivatives
6557 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6558 cd print *,'j=',j,' expfac=',expfac
6559 escloc_i=escloc_i+expfac
6561 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6565 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6566 & +gaussc(k,2,j,it))*expfac
6573 dersc(1)=dersc(1)/cos(theti)**2
6574 ddersc(1)=ddersc(1)/cos(theti)**2
6577 escloci=-(dlog(escloc_i)-emin)
6579 dersc(j)=dersc(j)/escloc_i
6583 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6588 C------------------------------------------------------------------------------
6589 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6590 implicit real*8 (a-h,o-z)
6591 include 'DIMENSIONS'
6592 include 'COMMON.GEO'
6593 include 'COMMON.LOCAL'
6594 include 'COMMON.IOUNITS'
6595 common /sccalc/ time11,time12,time112,theti,it,nlobit
6596 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6597 double precision contr(maxlob)
6608 z(k)=x(k)-censc(k,j,it)
6614 Axk=Axk+gaussc(l,k,j,it)*z(l)
6620 expfac=expfac+Ax(k,j)*z(k)
6625 C As in the case of ebend, we want to avoid underflows in exponentiation and
6626 C subsequent NaNs and INFs in energy calculation.
6627 C Find the largest exponent
6630 if (emin.gt.contr(j)) emin=contr(j)
6634 C Compute the contribution to SC energy and derivatives
6638 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6639 escloc_i=escloc_i+expfac
6641 dersc(k)=dersc(k)+Ax(k,j)*expfac
6643 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6644 & +gaussc(1,2,j,it))*expfac
6648 dersc(1)=dersc(1)/cos(theti)**2
6649 dersc12=dersc12/cos(theti)**2
6650 escloci=-(dlog(escloc_i)-emin)
6652 dersc(j)=dersc(j)/escloc_i
6654 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6658 c----------------------------------------------------------------------------------
6659 subroutine esc(escloc)
6660 C Calculate the local energy of a side chain and its derivatives in the
6661 C corresponding virtual-bond valence angles THETA and the spherical angles
6662 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6663 C added by Urszula Kozlowska. 07/11/2007
6665 implicit real*8 (a-h,o-z)
6666 include 'DIMENSIONS'
6667 include 'DIMENSIONS.ZSCOPT'
6668 include 'COMMON.GEO'
6669 include 'COMMON.LOCAL'
6670 include 'COMMON.VAR'
6671 include 'COMMON.SCROT'
6672 include 'COMMON.INTERACT'
6673 include 'COMMON.DERIV'
6674 include 'COMMON.CHAIN'
6675 include 'COMMON.IOUNITS'
6676 include 'COMMON.NAMES'
6677 include 'COMMON.FFIELD'
6678 include 'COMMON.CONTROL'
6679 include 'COMMON.VECTORS'
6680 double precision x_prime(3),y_prime(3),z_prime(3)
6681 & , sumene,dsc_i,dp2_i,x(65),
6682 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6683 & de_dxx,de_dyy,de_dzz,de_dt
6684 double precision s1_t,s1_6_t,s2_t,s2_6_t
6686 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6687 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6688 & dt_dCi(3),dt_dCi1(3)
6689 common /sccalc/ time11,time12,time112,theti,it,nlobit
6692 do i=loc_start,loc_end
6693 if (itype(i).eq.ntyp1) cycle
6694 costtab(i+1) =dcos(theta(i+1))
6695 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6696 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6697 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6698 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6699 cosfac=dsqrt(cosfac2)
6700 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6701 sinfac=dsqrt(sinfac2)
6703 if (it.eq.10) goto 1
6705 C Compute the axes of tghe local cartesian coordinates system; store in
6706 c x_prime, y_prime and z_prime
6713 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6714 C & dc_norm(3,i+nres)
6716 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6717 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6720 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6723 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6724 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6725 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6726 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6727 c & " xy",scalar(x_prime(1),y_prime(1)),
6728 c & " xz",scalar(x_prime(1),z_prime(1)),
6729 c & " yy",scalar(y_prime(1),y_prime(1)),
6730 c & " yz",scalar(y_prime(1),z_prime(1)),
6731 c & " zz",scalar(z_prime(1),z_prime(1))
6733 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6734 C to local coordinate system. Store in xx, yy, zz.
6740 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6741 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6742 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6749 C Compute the energy of the ith side cbain
6751 c write (2,*) "xx",xx," yy",yy," zz",zz
6754 x(j) = sc_parmin(j,it)
6757 Cc diagnostics - remove later
6759 yy1 = dsin(alph(2))*dcos(omeg(2))
6760 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
6761 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6762 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6764 C," --- ", xx_w,yy_w,zz_w
6767 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6768 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6770 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6771 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6773 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6774 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6775 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6776 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6777 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6779 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6780 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6781 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6782 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6783 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6785 dsc_i = 0.743d0+x(61)
6787 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6788 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6789 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6790 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6791 s1=(1+x(63))/(0.1d0 + dscp1)
6792 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6793 s2=(1+x(65))/(0.1d0 + dscp2)
6794 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6795 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6796 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6797 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6799 c & dscp1,dscp2,sumene
6800 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6801 escloc = escloc + sumene
6802 c write (2,*) "escloc",escloc
6803 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
6805 if (.not. calc_grad) goto 1
6808 C This section to check the numerical derivatives of the energy of ith side
6809 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6810 C #define DEBUG in the code to turn it on.
6812 write (2,*) "sumene =",sumene
6816 write (2,*) xx,yy,zz
6817 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6818 de_dxx_num=(sumenep-sumene)/aincr
6820 write (2,*) "xx+ sumene from enesc=",sumenep
6823 write (2,*) xx,yy,zz
6824 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6825 de_dyy_num=(sumenep-sumene)/aincr
6827 write (2,*) "yy+ sumene from enesc=",sumenep
6830 write (2,*) xx,yy,zz
6831 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6832 de_dzz_num=(sumenep-sumene)/aincr
6834 write (2,*) "zz+ sumene from enesc=",sumenep
6835 costsave=cost2tab(i+1)
6836 sintsave=sint2tab(i+1)
6837 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6838 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6839 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6840 de_dt_num=(sumenep-sumene)/aincr
6841 write (2,*) " t+ sumene from enesc=",sumenep
6842 cost2tab(i+1)=costsave
6843 sint2tab(i+1)=sintsave
6844 C End of diagnostics section.
6847 C Compute the gradient of esc
6849 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6850 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6851 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6852 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6853 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6854 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6855 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6856 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6857 pom1=(sumene3*sint2tab(i+1)+sumene1)
6858 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6859 pom2=(sumene4*cost2tab(i+1)+sumene2)
6860 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6861 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6862 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6863 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6865 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6866 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6867 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6869 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6870 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6871 & +(pom1+pom2)*pom_dx
6873 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
6876 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6877 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6878 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6880 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6881 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6882 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6883 & +x(59)*zz**2 +x(60)*xx*zz
6884 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6885 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6886 & +(pom1-pom2)*pom_dy
6888 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
6891 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6892 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6893 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6894 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6895 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6896 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6897 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6898 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6900 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
6903 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6904 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6905 & +pom1*pom_dt1+pom2*pom_dt2
6907 write(2,*), "de_dt = ", de_dt,de_dt_num
6911 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6912 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6913 cosfac2xx=cosfac2*xx
6914 sinfac2yy=sinfac2*yy
6916 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6918 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6920 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6921 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6922 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6923 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6924 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6925 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6926 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6927 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6928 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6929 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6933 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6934 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6935 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6936 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6939 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6940 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6941 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
6943 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6944 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6948 dXX_Ctab(k,i)=dXX_Ci(k)
6949 dXX_C1tab(k,i)=dXX_Ci1(k)
6950 dYY_Ctab(k,i)=dYY_Ci(k)
6951 dYY_C1tab(k,i)=dYY_Ci1(k)
6952 dZZ_Ctab(k,i)=dZZ_Ci(k)
6953 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6954 dXX_XYZtab(k,i)=dXX_XYZ(k)
6955 dYY_XYZtab(k,i)=dYY_XYZ(k)
6956 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6960 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6961 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6962 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6963 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6964 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6966 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6967 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6968 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6969 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6970 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6971 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6972 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6973 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6975 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6976 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6978 C to check gradient call subroutine check_grad
6985 c------------------------------------------------------------------------------
6986 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6988 C This procedure calculates two-body contact function g(rij) and its derivative:
6991 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6994 C where x=(rij-r0ij)/delta
6996 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6999 double precision rij,r0ij,eps0ij,fcont,fprimcont
7000 double precision x,x2,x4,delta
7004 if (x.lt.-1.0D0) then
7007 else if (x.le.1.0D0) then
7010 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7011 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7018 c------------------------------------------------------------------------------
7019 subroutine splinthet(theti,delta,ss,ssder)
7020 implicit real*8 (a-h,o-z)
7021 include 'DIMENSIONS'
7022 include 'DIMENSIONS.ZSCOPT'
7023 include 'COMMON.VAR'
7024 include 'COMMON.GEO'
7027 if (theti.gt.pipol) then
7028 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7030 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7035 c------------------------------------------------------------------------------
7036 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7038 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7039 double precision ksi,ksi2,ksi3,a1,a2,a3
7040 a1=fprim0*delta/(f1-f0)
7046 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7047 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7050 c------------------------------------------------------------------------------
7051 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7053 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7054 double precision ksi,ksi2,ksi3,a1,a2,a3
7059 a2=3*(f1x-f0x)-2*fprim0x*delta
7060 a3=fprim0x*delta-2*(f1x-f0x)
7061 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7064 C-----------------------------------------------------------------------------
7066 C-----------------------------------------------------------------------------
7067 subroutine etor(etors)
7068 implicit real*8 (a-h,o-z)
7069 include 'DIMENSIONS'
7070 include 'DIMENSIONS.ZSCOPT'
7071 include 'COMMON.VAR'
7072 include 'COMMON.GEO'
7073 include 'COMMON.LOCAL'
7074 include 'COMMON.TORSION'
7075 include 'COMMON.INTERACT'
7076 include 'COMMON.DERIV'
7077 include 'COMMON.CHAIN'
7078 include 'COMMON.NAMES'
7079 include 'COMMON.IOUNITS'
7080 include 'COMMON.FFIELD'
7081 include 'COMMON.TORCNSTR'
7083 C Set lprn=.true. for debugging
7087 do i=iphi_start,iphi_end
7088 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
7089 & .or. itype(i).eq.ntyp1) cycle
7090 itori=itortyp(itype(i-2))
7091 itori1=itortyp(itype(i-1))
7094 C Proline-Proline pair is a special case...
7095 if (itori.eq.3 .and. itori1.eq.3) then
7096 if (phii.gt.-dwapi3) then
7098 fac=1.0D0/(1.0D0-cosphi)
7099 etorsi=v1(1,3,3)*fac
7100 etorsi=etorsi+etorsi
7101 etors=etors+etorsi-v1(1,3,3)
7102 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7105 v1ij=v1(j+1,itori,itori1)
7106 v2ij=v2(j+1,itori,itori1)
7109 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7110 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7114 v1ij=v1(j,itori,itori1)
7115 v2ij=v2(j,itori,itori1)
7118 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7119 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7123 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7124 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7125 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7126 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7127 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7131 c------------------------------------------------------------------------------
7133 subroutine etor(etors)
7134 implicit real*8 (a-h,o-z)
7135 include 'DIMENSIONS'
7136 include 'DIMENSIONS.ZSCOPT'
7137 include 'COMMON.VAR'
7138 include 'COMMON.GEO'
7139 include 'COMMON.LOCAL'
7140 include 'COMMON.TORSION'
7141 include 'COMMON.INTERACT'
7142 include 'COMMON.DERIV'
7143 include 'COMMON.CHAIN'
7144 include 'COMMON.NAMES'
7145 include 'COMMON.IOUNITS'
7146 include 'COMMON.FFIELD'
7147 include 'COMMON.TORCNSTR'
7148 include 'COMMON.WEIGHTS'
7149 include 'COMMON.WEIGHTDER'
7151 C Set lprn=.true. for debugging
7160 etor_temp(l,k,j,i,iblock)=0.0d0
7166 do i=iphi_start,iphi_end
7168 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7169 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7170 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
7171 if (iabs(itype(i)).eq.20) then
7176 itori=itortyp(itype(i-2))
7177 itori1=itortyp(itype(i-1))
7178 weitori=weitor(0,itori,itori1,iblock)
7182 C Regular cosine and sine terms
7183 do j=1,nterm(itori,itori1,iblock)
7184 v1ij=v1(j,itori,itori1,iblock)
7185 v2ij=v2(j,itori,itori1,iblock)
7188 etori=etori+v1ij*cosphi+v2ij*sinphi
7189 etor_temp(j,0,itori,itori1,iblock)=
7190 & etor_temp(j,0,itori,itori1,iblock)+cosphi*ww(13)
7191 etor_temp(nterm(itori,itori1,iblock)+j,0,itori,itori1,iblock)=
7192 & etor_temp(nterm(itori,itori1,iblock)+j,0,itori,itori1,iblock)+
7194 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7198 C E = SUM ----------------------------------- - v1
7199 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7201 cosphi=dcos(0.5d0*phii)
7202 sinphi=dsin(0.5d0*phii)
7203 do j=1,nlor(itori,itori1,iblock)
7204 vl1ij=vlor1(j,itori,itori1)
7205 vl2ij=vlor2(j,itori,itori1)
7206 vl3ij=vlor3(j,itori,itori1)
7207 pom=vl2ij*cosphi+vl3ij*sinphi
7208 pom1=1.0d0/(pom*pom+1.0d0)
7209 etori=etori+vl1ij*pom1
7211 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7213 C Subtract the constant term
7214 etors=etors+(etori-v0(itori,itori1,iblock))*weitori
7215 etor_temp(0,0,itori,itori1,1)=etor_temp(0,0,itori,itori1,1)+
7216 & (etori-v0(itori,itori1,iblock))*ww(13)
7219 write (iout,'(2(a3,2x,i3,2x),2i3,8f8.3/26x,6f8.3/)')
7220 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7221 & weitori,v0(itori,itori1,iblock)*weitori,
7222 & (v1(j,itori,itori1,iblock)*weitori,
7223 & j=1,6),(v2(j,itori,itori1,iblock)*weitori,j=1,6)
7224 write (iout,*) "typ",itori,iloctyp(itori),itori1,
7225 & iloctyp(itori1)," etor_temp",
7226 & etor_temp(0,0,itori,itori1,1)
7229 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7230 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7235 c----------------------------------------------------------------------------
7236 subroutine etor_d(etors_d)
7237 C 6/23/01 Compute double torsional energy
7238 implicit real*8 (a-h,o-z)
7239 include 'DIMENSIONS'
7240 include 'DIMENSIONS.ZSCOPT'
7241 include 'COMMON.VAR'
7242 include 'COMMON.GEO'
7243 include 'COMMON.LOCAL'
7244 include 'COMMON.TORSION'
7245 include 'COMMON.INTERACT'
7246 include 'COMMON.DERIV'
7247 include 'COMMON.CHAIN'
7248 include 'COMMON.NAMES'
7249 include 'COMMON.IOUNITS'
7250 include 'COMMON.FFIELD'
7251 include 'COMMON.TORCNSTR'
7253 C Set lprn=.true. for debugging
7257 do i=iphi_start,iphi_end-1
7259 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7260 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
7261 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
7262 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
7263 & (itype(i+1).eq.ntyp1)) cycle
7264 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
7266 itori=itortyp(itype(i-2))
7267 itori1=itortyp(itype(i-1))
7268 itori2=itortyp(itype(i))
7274 if (iabs(itype(i+1)).eq.20) iblock=2
7275 C Regular cosine and sine terms
7276 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7277 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7278 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7279 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7280 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7281 cosphi1=dcos(j*phii)
7282 sinphi1=dsin(j*phii)
7283 cosphi2=dcos(j*phii1)
7284 sinphi2=dsin(j*phii1)
7285 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7286 & v2cij*cosphi2+v2sij*sinphi2
7287 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7288 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7290 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7292 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7293 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7294 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7295 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7296 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7297 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7298 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7299 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7300 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7301 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7302 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7303 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7304 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7305 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7308 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7309 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7315 c---------------------------------------------------------------------------
7316 C The rigorous attempt to derive energy function
7317 subroutine etor_kcc(etors)
7318 implicit real*8 (a-h,o-z)
7319 include 'DIMENSIONS'
7320 include 'DIMENSIONS.ZSCOPT'
7321 include 'COMMON.VAR'
7322 include 'COMMON.GEO'
7323 include 'COMMON.LOCAL'
7324 include 'COMMON.TORSION'
7325 include 'COMMON.INTERACT'
7326 include 'COMMON.DERIV'
7327 include 'COMMON.CHAIN'
7328 include 'COMMON.NAMES'
7329 include 'COMMON.IOUNITS'
7330 include 'COMMON.FFIELD'
7331 include 'COMMON.TORCNSTR'
7332 include 'COMMON.CONTROL'
7333 include 'COMMON.WEIGHTS'
7334 include 'COMMON.WEIGHTDER'
7335 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
7337 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
7338 C Set lprn=.true. for debugging
7341 if (lprn) write (iout,*)"ETOR_KCC"
7347 etor_temp(l,k,j,i,iblock)=0.0d0
7358 etor_temp_kcc(ll,l,k,j,i)=0.0d0
7364 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7366 do i=iphi_start,iphi_end
7367 C ANY TWO ARE DUMMY ATOMS in row CYCLE
7368 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7369 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7370 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7371 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
7372 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
7373 itori=itortyp(itype(i-2))
7374 itori1=itortyp(itype(i-1))
7375 weitori=weitor(0,itori,itori1,1)
7376 if (lprn) write (iout,*) i-2,i-2,itori,itori1,"weitor",weitori
7381 C to avoid multiple devision by 2
7382 c theti22=0.5d0*theta(i)
7383 C theta 12 is the theta_1 /2
7384 C theta 22 is theta_2 /2
7385 c theti12=0.5d0*theta(i-1)
7386 C and appropriate sinus function
7387 sinthet1=dsin(theta(i-1))
7388 sinthet2=dsin(theta(i))
7389 costhet1=dcos(theta(i-1))
7390 costhet2=dcos(theta(i))
7391 C to speed up lets store its mutliplication
7392 sint1t2=sinthet2*sinthet1
7394 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7395 C +d_n*sin(n*gamma)) *
7396 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7397 C we have two sum 1) Non-Chebyshev which is with n and gamma
7398 nval=nterm_kcc_Tb(itori,itori1)
7404 c1(j)=c1(j-1)*costhet1
7405 c2(j)=c2(j-1)*costhet2
7408 do j=1,nterm_kcc(itori,itori1)
7412 sint1t2n=sint1t2n*sint1t2
7418 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7419 etor_temp_kcc(l,k,j,itori,itori1)=
7420 & etor_temp_kcc(l,k,j,itori,itori1)+
7421 & c1(k)*c2(l)*sint1t2n*cosphi*ww(13)
7422 gradvalct1=gradvalct1+
7423 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7424 gradvalct2=gradvalct2+
7425 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7428 gradvalct1=-gradvalct1*sinthet1
7429 gradvalct2=-gradvalct2*sinthet2
7435 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7436 etor_temp_kcc(l,k,j+nterm_kcc(itori,itori1),itori,itori1)=
7437 & etor_temp_kcc(l,k,j+nterm_kcc(itori,itori1),itori,itori1)+
7438 & c1(k)*c2(l)*sint1t2n*sinphi*ww(13)
7439 gradvalst1=gradvalst1+
7440 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7441 gradvalst2=gradvalst2+
7442 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7445 gradvalst1=-gradvalst1*sinthet1
7446 gradvalst2=-gradvalst2*sinthet2
7447 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
7448 etor_temp(0,0,itori,itori1,1)=etor_temp(0,0,itori,itori1,1)
7449 & +sint1t2n*(sumvalc*cosphi+sumvals*sinphi)*ww(13)
7450 C glocig is the gradient local i site in gamma
7451 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
7452 C now gradient over theta_1
7453 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
7454 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
7455 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
7456 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
7458 etors=etors+etori*weitori
7459 C derivative over gamma
7460 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7461 C derivative over theta1
7462 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7463 C now derivative over theta2
7464 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7466 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
7467 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7471 c---------------------------------------------------------------------------------------------
7472 subroutine etor_constr(edihcnstr)
7473 implicit real*8 (a-h,o-z)
7474 include 'DIMENSIONS'
7475 include 'DIMENSIONS.ZSCOPT'
7476 include 'COMMON.VAR'
7477 include 'COMMON.GEO'
7478 include 'COMMON.LOCAL'
7479 include 'COMMON.TORSION'
7480 include 'COMMON.INTERACT'
7481 include 'COMMON.DERIV'
7482 include 'COMMON.CHAIN'
7483 include 'COMMON.NAMES'
7484 include 'COMMON.IOUNITS'
7485 include 'COMMON.FFIELD'
7486 include 'COMMON.TORCNSTR'
7487 include 'COMMON.CONTROL'
7488 ! 6/20/98 - dihedral angle constraints
7490 c do i=1,ndih_constr
7491 c write (iout,*) "idihconstr_start",idihconstr_start,
7492 c & " idihconstr_end",idihconstr_end
7493 do i=idihconstr_start,idihconstr_end
7494 itori=idih_constr(i)
7496 difi=pinorm(phii-phi0(i))
7497 if (difi.gt.drange(i)) then
7499 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7500 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7501 else if (difi.lt.-drange(i)) then
7503 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7504 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7511 c----------------------------------------------------------------------------
7512 C The rigorous attempt to derive energy function
7513 subroutine ebend_kcc(etheta)
7515 implicit real*8 (a-h,o-z)
7516 include 'DIMENSIONS'
7517 include 'DIMENSIONS.ZSCOPT'
7518 include 'COMMON.VAR'
7519 include 'COMMON.GEO'
7520 include 'COMMON.LOCAL'
7521 include 'COMMON.TORSION'
7522 include 'COMMON.INTERACT'
7523 include 'COMMON.DERIV'
7524 include 'COMMON.CHAIN'
7525 include 'COMMON.NAMES'
7526 include 'COMMON.IOUNITS'
7527 include 'COMMON.FFIELD'
7528 include 'COMMON.TORCNSTR'
7529 include 'COMMON.CONTROL'
7530 include 'COMMON.WEIGHTDER'
7532 double precision thybt1(maxang_kcc)
7533 C Set lprn=.true. for debugging
7536 C print *,"wchodze kcc"
7537 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7540 ebend_temp_kcc(j,i)=0.0d0
7544 do i=ithet_start,ithet_end
7545 c print *,i,itype(i-1),itype(i),itype(i-2)
7546 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
7547 & .or.itype(i).eq.ntyp1) cycle
7548 iti=iabs(itortyp(itype(i-1)))
7549 sinthet=dsin(theta(i))
7550 costhet=dcos(theta(i))
7551 do j=1,nbend_kcc_Tb(iti)
7552 thybt1(j)=v1bend_chyb(j,iti)
7553 ebend_temp_kcc(j,iti)=ebend_temp_kcc(j,iti)+dcos(j*theta(i))
7555 sumth1thyb=v1bend_chyb(0,iti)+
7556 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7557 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
7559 ihelp=nbend_kcc_Tb(iti)-1
7560 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
7561 etheta=etheta+sumth1thyb
7562 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7563 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
7567 c-------------------------------------------------------------------------------------
7568 subroutine etheta_constr(ethetacnstr)
7570 implicit real*8 (a-h,o-z)
7571 include 'DIMENSIONS'
7572 include 'DIMENSIONS.ZSCOPT'
7573 include 'COMMON.VAR'
7574 include 'COMMON.GEO'
7575 include 'COMMON.LOCAL'
7576 include 'COMMON.TORSION'
7577 include 'COMMON.INTERACT'
7578 include 'COMMON.DERIV'
7579 include 'COMMON.CHAIN'
7580 include 'COMMON.NAMES'
7581 include 'COMMON.IOUNITS'
7582 include 'COMMON.FFIELD'
7583 include 'COMMON.TORCNSTR'
7584 include 'COMMON.CONTROL'
7586 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7587 do i=ithetaconstr_start,ithetaconstr_end
7588 itheta=itheta_constr(i)
7589 thetiii=theta(itheta)
7590 difi=pinorm(thetiii-theta_constr0(i))
7591 if (difi.gt.theta_drange(i)) then
7592 difi=difi-theta_drange(i)
7593 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7594 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7595 & +for_thet_constr(i)*difi**3
7596 else if (difi.lt.-drange(i)) then
7598 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7599 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
7600 & +for_thet_constr(i)*difi**3
7604 if (energy_dec) then
7605 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
7606 & i,itheta,rad2deg*thetiii,
7607 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
7608 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
7609 & gloc(itheta+nphi-2,icg)
7614 c------------------------------------------------------------------------------
7615 subroutine eback_sc_corr(esccor)
7616 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7617 c conformational states; temporarily implemented as differences
7618 c between UNRES torsional potentials (dependent on three types of
7619 c residues) and the torsional potentials dependent on all 20 types
7620 c of residues computed from AM1 energy surfaces of terminally-blocked
7621 c amino-acid residues.
7622 implicit real*8 (a-h,o-z)
7623 include 'DIMENSIONS'
7624 include 'DIMENSIONS.ZSCOPT'
7625 include 'COMMON.VAR'
7626 include 'COMMON.GEO'
7627 include 'COMMON.LOCAL'
7628 include 'COMMON.TORSION'
7629 include 'COMMON.SCCOR'
7630 include 'COMMON.INTERACT'
7631 include 'COMMON.DERIV'
7632 include 'COMMON.CHAIN'
7633 include 'COMMON.NAMES'
7634 include 'COMMON.IOUNITS'
7635 include 'COMMON.FFIELD'
7636 include 'COMMON.CONTROL'
7638 C Set lprn=.true. for debugging
7641 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
7643 do i=itau_start,itau_end
7644 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7646 isccori=isccortyp(itype(i-2))
7647 isccori1=isccortyp(itype(i-1))
7649 do intertyp=1,3 !intertyp
7650 cc Added 09 May 2012 (Adasko)
7651 cc Intertyp means interaction type of backbone mainchain correlation:
7652 c 1 = SC...Ca...Ca...Ca
7653 c 2 = Ca...Ca...Ca...SC
7654 c 3 = SC...Ca...Ca...SCi
7656 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7657 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7658 & (itype(i-1).eq.ntyp1)))
7659 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7660 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7661 & .or.(itype(i).eq.ntyp1)))
7662 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7663 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7664 & (itype(i-3).eq.ntyp1)))) cycle
7665 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7666 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7668 do j=1,nterm_sccor(isccori,isccori1)
7669 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7670 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7671 cosphi=dcos(j*tauangle(intertyp,i))
7672 sinphi=dsin(j*tauangle(intertyp,i))
7673 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7674 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7676 C write (iout,*)"EBACK_SC_COR",esccor,i
7677 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
7678 c & nterm_sccor(isccori,isccori1),isccori,isccori1
7679 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7681 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7682 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7683 & (v1sccor(j,1,itori,itori1),j=1,6)
7684 & ,(v2sccor(j,1,itori,itori1),j=1,6)
7685 c gsccor_loc(i-3)=gloci
7690 c------------------------------------------------------------------------------
7691 subroutine multibody(ecorr)
7692 C This subroutine calculates multi-body contributions to energy following
7693 C the idea of Skolnick et al. If side chains I and J make a contact and
7694 C at the same time side chains I+1 and J+1 make a contact, an extra
7695 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7696 implicit real*8 (a-h,o-z)
7697 include 'DIMENSIONS'
7698 include 'DIMENSIONS.ZSCOPT'
7699 include 'COMMON.IOUNITS'
7700 include 'COMMON.DERIV'
7701 include 'COMMON.INTERACT'
7702 include 'COMMON.CONTACTS'
7703 double precision gx(3),gx1(3)
7706 C Set lprn=.true. for debugging
7710 write (iout,'(a)') 'Contact function values:'
7712 write (iout,'(i2,20(1x,i2,f10.5))')
7713 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7728 num_conti=num_cont(i)
7729 num_conti1=num_cont(i1)
7734 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7735 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7736 cd & ' ishift=',ishift
7737 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7738 C The system gains extra energy.
7739 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7740 endif ! j1==j+-ishift
7749 c------------------------------------------------------------------------------
7750 double precision function esccorr(i,j,k,l,jj,kk)
7751 implicit real*8 (a-h,o-z)
7752 include 'DIMENSIONS'
7753 include 'DIMENSIONS.ZSCOPT'
7754 include 'COMMON.IOUNITS'
7755 include 'COMMON.DERIV'
7756 include 'COMMON.INTERACT'
7757 include 'COMMON.CONTACTS'
7758 double precision gx(3),gx1(3)
7763 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7764 C Calculate the multi-body contribution to energy.
7765 C Calculate multi-body contributions to the gradient.
7766 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7767 cd & k,l,(gacont(m,kk,k),m=1,3)
7769 gx(m) =ekl*gacont(m,jj,i)
7770 gx1(m)=eij*gacont(m,kk,k)
7771 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7772 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7773 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7774 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7778 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7783 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7789 c------------------------------------------------------------------------------
7790 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7791 C This subroutine calculates multi-body contributions to hydrogen-bonding
7792 implicit real*8 (a-h,o-z)
7793 include 'DIMENSIONS'
7794 include 'DIMENSIONS.ZSCOPT'
7795 include 'COMMON.IOUNITS'
7796 include 'COMMON.FFIELD'
7797 include 'COMMON.DERIV'
7798 include 'COMMON.INTERACT'
7799 include 'COMMON.CONTACTS'
7800 double precision gx(3),gx1(3)
7803 C Set lprn=.true. for debugging
7806 write (iout,'(a)') 'Contact function values:'
7808 write (iout,'(2i3,50(1x,i2,f5.2))')
7809 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7810 & j=1,num_cont_hb(i))
7814 C Remove the loop below after debugging !!!
7821 C Calculate the local-electrostatic correlation terms
7822 do i=iatel_s,iatel_e+1
7824 num_conti=num_cont_hb(i)
7825 num_conti1=num_cont_hb(i+1)
7830 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7831 c & ' jj=',jj,' kk=',kk
7832 if (j1.eq.j+1 .or. j1.eq.j-1) then
7833 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7834 C The system gains extra energy.
7835 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7837 else if (j1.eq.j) then
7838 C Contacts I-J and I-(J+1) occur simultaneously.
7839 C The system loses extra energy.
7840 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7845 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7846 c & ' jj=',jj,' kk=',kk
7848 C Contacts I-J and (I+1)-J occur simultaneously.
7849 C The system loses extra energy.
7850 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7857 c------------------------------------------------------------------------------
7858 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7860 C This subroutine calculates multi-body contributions to hydrogen-bonding
7861 implicit real*8 (a-h,o-z)
7862 include 'DIMENSIONS'
7863 include 'DIMENSIONS.ZSCOPT'
7864 include 'COMMON.IOUNITS'
7868 include 'COMMON.FFIELD'
7869 include 'COMMON.DERIV'
7870 include 'COMMON.LOCAL'
7871 include 'COMMON.INTERACT'
7872 include 'COMMON.CONTACTS'
7873 include 'COMMON.CHAIN'
7874 include 'COMMON.CONTROL'
7875 include 'COMMON.SHIELD'
7876 double precision gx(3),gx1(3)
7877 integer num_cont_hb_old(maxres)
7879 double precision eello4,eello5,eelo6,eello_turn6
7880 external eello4,eello5,eello6,eello_turn6
7881 C Set lprn=.true. for debugging
7885 write (iout,'(a)') 'Contact function values:'
7887 write (iout,'(2i3,50(1x,i2,5f6.3))')
7888 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7889 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7895 C Remove the loop below after debugging !!!
7902 C Calculate the dipole-dipole interaction energies
7903 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7904 do i=iatel_s,iatel_e+1
7905 num_conti=num_cont_hb(i)
7914 C Calculate the local-electrostatic correlation terms
7915 c write (iout,*) "gradcorr5 in eello5 before loop"
7917 c write (iout,'(i5,3f10.5)')
7918 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7920 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7921 c write (iout,*) "corr loop i",i
7923 num_conti=num_cont_hb(i)
7924 num_conti1=num_cont_hb(i+1)
7931 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7932 c & ' jj=',jj,' kk=',kk
7933 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7934 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7935 & .or. j.lt.0 .and. j1.gt.0) .and.
7936 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7937 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7938 C The system gains extra energy.
7940 sqd1=dsqrt(d_cont(jj,i))
7941 sqd2=dsqrt(d_cont(kk,i1))
7942 sred_geom = sqd1*sqd2
7943 IF (sred_geom.lt.cutoff_corr) THEN
7944 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7946 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7947 cd & ' jj=',jj,' kk=',kk
7948 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7949 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7951 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7952 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7955 cd write (iout,*) 'sred_geom=',sred_geom,
7956 cd & ' ekont=',ekont,' fprim=',fprimcont,
7957 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7958 cd write (iout,*) "g_contij",g_contij
7959 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7960 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7961 call calc_eello(i,jp,i+1,jp1,jj,kk)
7962 if (wcorr4.gt.0.0d0)
7963 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7964 CC & *fac_shield(i)**2*fac_shield(j)**2
7965 if (energy_dec.and.wcorr4.gt.0.0d0)
7966 1 write (iout,'(a6,4i5,0pf7.3)')
7967 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7968 c write (iout,*) "gradcorr5 before eello5"
7970 c write (iout,'(i5,3f10.5)')
7971 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7973 if (wcorr5.gt.0.0d0)
7974 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7975 c write (iout,*) "gradcorr5 after eello5"
7977 c write (iout,'(i5,3f10.5)')
7978 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7980 if (energy_dec.and.wcorr5.gt.0.0d0)
7981 1 write (iout,'(a6,4i5,0pf7.3)')
7982 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7983 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7984 cd write(2,*)'ijkl',i,jp,i+1,jp1
7985 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7986 & .or. wturn6.eq.0.0d0))then
7987 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7988 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7989 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7990 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7991 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7992 cd & 'ecorr6=',ecorr6
7993 cd write (iout,'(4e15.5)') sred_geom,
7994 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7995 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7996 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7997 else if (wturn6.gt.0.0d0
7998 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7999 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8000 eturn6=eturn6+eello_turn6(i,jj,kk)
8001 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8002 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8003 cd write (2,*) 'multibody_eello:eturn6',eturn6
8012 num_cont_hb(i)=num_cont_hb_old(i)
8014 c write (iout,*) "gradcorr5 in eello5"
8016 c write (iout,'(i5,3f10.5)')
8017 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8021 c------------------------------------------------------------------------------
8022 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8023 implicit real*8 (a-h,o-z)
8024 include 'DIMENSIONS'
8025 include 'DIMENSIONS.ZSCOPT'
8026 include 'COMMON.IOUNITS'
8027 include 'COMMON.DERIV'
8028 include 'COMMON.INTERACT'
8029 include 'COMMON.CONTACTS'
8030 include 'COMMON.SHIELD'
8031 include 'COMMON.CONTROL'
8032 double precision gx(3),gx1(3)
8035 C print *,"wchodze",fac_shield(i),shield_mode
8043 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8045 C & fac_shield(i)**2*fac_shield(j)**2
8046 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8047 C Following 4 lines for diagnostics.
8052 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8053 c & 'Contacts ',i,j,
8054 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8055 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8057 C Calculate the multi-body contribution to energy.
8058 C ecorr=ecorr+ekont*ees
8059 C Calculate multi-body contributions to the gradient.
8060 coeffpees0pij=coeffp*ees0pij
8061 coeffmees0mij=coeffm*ees0mij
8062 coeffpees0pkl=coeffp*ees0pkl
8063 coeffmees0mkl=coeffm*ees0mkl
8065 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8066 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8067 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8068 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8069 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8070 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8071 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8072 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8073 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8074 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8075 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8076 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8077 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8078 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8079 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8080 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8081 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8082 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8083 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8084 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8085 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8086 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8087 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8088 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8089 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8094 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8095 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8096 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8097 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8102 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8103 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8104 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8105 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8108 c write (iout,*) "ehbcorr",ekont*ees
8109 C print *,ekont,ees,i,k
8111 C now gradient over shielding
8113 if (shield_mode.gt.0) then
8116 C print *,i,j,fac_shield(i),fac_shield(j),
8117 C &fac_shield(k),fac_shield(l)
8118 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
8119 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8120 do ilist=1,ishield_list(i)
8121 iresshield=shield_list(ilist,i)
8123 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8125 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8127 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8128 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8132 do ilist=1,ishield_list(j)
8133 iresshield=shield_list(ilist,j)
8135 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8137 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8139 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8140 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8145 do ilist=1,ishield_list(k)
8146 iresshield=shield_list(ilist,k)
8148 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8150 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8152 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8153 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8157 do ilist=1,ishield_list(l)
8158 iresshield=shield_list(ilist,l)
8160 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8162 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
8164 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8165 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
8169 C print *,gshieldx(m,iresshield)
8171 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
8172 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8173 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
8174 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8175 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
8176 & grad_shield(m,i)*ehbcorr/fac_shield(i)
8177 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
8178 & grad_shield(m,j)*ehbcorr/fac_shield(j)
8180 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
8181 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8182 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
8183 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8184 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
8185 & grad_shield(m,k)*ehbcorr/fac_shield(k)
8186 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
8187 & grad_shield(m,l)*ehbcorr/fac_shield(l)
8195 C---------------------------------------------------------------------------
8196 subroutine dipole(i,j,jj)
8197 implicit real*8 (a-h,o-z)
8198 include 'DIMENSIONS'
8199 include 'DIMENSIONS.ZSCOPT'
8200 include 'COMMON.IOUNITS'
8201 include 'COMMON.CHAIN'
8202 include 'COMMON.FFIELD'
8203 include 'COMMON.DERIV'
8204 include 'COMMON.INTERACT'
8205 include 'COMMON.CONTACTS'
8206 include 'COMMON.TORSION'
8207 include 'COMMON.VAR'
8208 include 'COMMON.GEO'
8209 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8211 iti1 = itortyp(itype(i+1))
8212 if (j.lt.nres-1) then
8213 itj1 = itype2loc(itype(j+1))
8218 dipi(iii,1)=Ub2(iii,i)
8219 dipderi(iii)=Ub2der(iii,i)
8220 dipi(iii,2)=b1(iii,i+1)
8221 dipj(iii,1)=Ub2(iii,j)
8222 dipderj(iii)=Ub2der(iii,j)
8223 dipj(iii,2)=b1(iii,j+1)
8227 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8230 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8237 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8241 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8246 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8247 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8249 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8251 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8253 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8258 C---------------------------------------------------------------------------
8259 subroutine calc_eello(i,j,k,l,jj,kk)
8261 C This subroutine computes matrices and vectors needed to calculate
8262 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8264 implicit real*8 (a-h,o-z)
8265 include 'DIMENSIONS'
8266 include 'DIMENSIONS.ZSCOPT'
8267 include 'COMMON.IOUNITS'
8268 include 'COMMON.CHAIN'
8269 include 'COMMON.DERIV'
8270 include 'COMMON.INTERACT'
8271 include 'COMMON.CONTACTS'
8272 include 'COMMON.TORSION'
8273 include 'COMMON.VAR'
8274 include 'COMMON.GEO'
8275 include 'COMMON.FFIELD'
8276 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8277 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8280 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8281 cd & ' jj=',jj,' kk=',kk
8282 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8283 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8284 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8287 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8288 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8291 call transpose2(aa1(1,1),aa1t(1,1))
8292 call transpose2(aa2(1,1),aa2t(1,1))
8295 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8296 & aa1tder(1,1,lll,kkk))
8297 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8298 & aa2tder(1,1,lll,kkk))
8302 C parallel orientation of the two CA-CA-CA frames.
8304 iti=itype2loc(itype(i))
8308 itk1=itype2loc(itype(k+1))
8309 itj=itype2loc(itype(j))
8310 if (l.lt.nres-1) then
8311 itl1=itype2loc(itype(l+1))
8315 C A1 kernel(j+1) A2T
8317 cd write (iout,'(3f10.5,5x,3f10.5)')
8318 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8320 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8321 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8322 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8323 C Following matrices are needed only for 6-th order cumulants
8324 IF (wcorr6.gt.0.0d0) THEN
8325 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8326 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8327 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8328 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8329 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8330 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8331 & ADtEAderx(1,1,1,1,1,1))
8333 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8334 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8335 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8336 & ADtEA1derx(1,1,1,1,1,1))
8338 C End 6-th order cumulants
8341 cd write (2,*) 'In calc_eello6'
8343 cd write (2,*) 'iii=',iii
8345 cd write (2,*) 'kkk=',kkk
8347 cd write (2,'(3(2f10.5),5x)')
8348 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8353 call transpose2(EUgder(1,1,k),auxmat(1,1))
8354 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8355 call transpose2(EUg(1,1,k),auxmat(1,1))
8356 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8357 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8361 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8362 & EAEAderx(1,1,lll,kkk,iii,1))
8366 C A1T kernel(i+1) A2
8367 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8368 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8369 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8370 C Following matrices are needed only for 6-th order cumulants
8371 IF (wcorr6.gt.0.0d0) THEN
8372 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8373 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8374 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8375 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8376 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8377 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8378 & ADtEAderx(1,1,1,1,1,2))
8379 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8380 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8381 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8382 & ADtEA1derx(1,1,1,1,1,2))
8384 C End 6-th order cumulants
8385 call transpose2(EUgder(1,1,l),auxmat(1,1))
8386 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8387 call transpose2(EUg(1,1,l),auxmat(1,1))
8388 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8389 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8393 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8394 & EAEAderx(1,1,lll,kkk,iii,2))
8399 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8400 C They are needed only when the fifth- or the sixth-order cumulants are
8402 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8403 call transpose2(AEA(1,1,1),auxmat(1,1))
8404 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8405 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8406 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8407 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8408 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8409 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8410 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8411 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8412 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8413 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8414 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8415 call transpose2(AEA(1,1,2),auxmat(1,1))
8416 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8417 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8418 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8419 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8420 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8421 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8422 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8423 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8424 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8425 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8426 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8427 C Calculate the Cartesian derivatives of the vectors.
8431 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8432 call matvec2(auxmat(1,1),b1(1,i),
8433 & AEAb1derx(1,lll,kkk,iii,1,1))
8434 call matvec2(auxmat(1,1),Ub2(1,i),
8435 & AEAb2derx(1,lll,kkk,iii,1,1))
8436 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8437 & AEAb1derx(1,lll,kkk,iii,2,1))
8438 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8439 & AEAb2derx(1,lll,kkk,iii,2,1))
8440 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8441 call matvec2(auxmat(1,1),b1(1,j),
8442 & AEAb1derx(1,lll,kkk,iii,1,2))
8443 call matvec2(auxmat(1,1),Ub2(1,j),
8444 & AEAb2derx(1,lll,kkk,iii,1,2))
8445 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8446 & AEAb1derx(1,lll,kkk,iii,2,2))
8447 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8448 & AEAb2derx(1,lll,kkk,iii,2,2))
8455 C Antiparallel orientation of the two CA-CA-CA frames.
8457 iti=itype2loc(itype(i))
8461 itk1=itype2loc(itype(k+1))
8462 itl=itype2loc(itype(l))
8463 itj=itype2loc(itype(j))
8464 if (j.lt.nres-1) then
8465 itj1=itype2loc(itype(j+1))
8469 C A2 kernel(j-1)T A1T
8470 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8471 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8472 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8473 C Following matrices are needed only for 6-th order cumulants
8474 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8475 & j.eq.i+4 .and. l.eq.i+3)) THEN
8476 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8477 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8478 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8479 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8480 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8481 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8482 & ADtEAderx(1,1,1,1,1,1))
8483 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8484 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8485 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8486 & ADtEA1derx(1,1,1,1,1,1))
8488 C End 6-th order cumulants
8489 call transpose2(EUgder(1,1,k),auxmat(1,1))
8490 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8491 call transpose2(EUg(1,1,k),auxmat(1,1))
8492 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8493 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8497 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8498 & EAEAderx(1,1,lll,kkk,iii,1))
8502 C A2T kernel(i+1)T A1
8503 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8504 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8505 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8506 C Following matrices are needed only for 6-th order cumulants
8507 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8508 & j.eq.i+4 .and. l.eq.i+3)) THEN
8509 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8510 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8511 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8512 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8513 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8514 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8515 & ADtEAderx(1,1,1,1,1,2))
8516 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8517 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8518 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8519 & ADtEA1derx(1,1,1,1,1,2))
8521 C End 6-th order cumulants
8522 call transpose2(EUgder(1,1,j),auxmat(1,1))
8523 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8524 call transpose2(EUg(1,1,j),auxmat(1,1))
8525 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8526 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8530 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8531 & EAEAderx(1,1,lll,kkk,iii,2))
8536 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8537 C They are needed only when the fifth- or the sixth-order cumulants are
8539 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8540 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8541 call transpose2(AEA(1,1,1),auxmat(1,1))
8542 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8543 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8544 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8545 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8546 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8547 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8548 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8549 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8550 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8551 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8552 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8553 call transpose2(AEA(1,1,2),auxmat(1,1))
8554 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8555 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8556 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8557 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8558 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8559 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8560 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8561 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8562 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8563 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8564 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8565 C Calculate the Cartesian derivatives of the vectors.
8569 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8570 call matvec2(auxmat(1,1),b1(1,i),
8571 & AEAb1derx(1,lll,kkk,iii,1,1))
8572 call matvec2(auxmat(1,1),Ub2(1,i),
8573 & AEAb2derx(1,lll,kkk,iii,1,1))
8574 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8575 & AEAb1derx(1,lll,kkk,iii,2,1))
8576 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8577 & AEAb2derx(1,lll,kkk,iii,2,1))
8578 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8579 call matvec2(auxmat(1,1),b1(1,l),
8580 & AEAb1derx(1,lll,kkk,iii,1,2))
8581 call matvec2(auxmat(1,1),Ub2(1,l),
8582 & AEAb2derx(1,lll,kkk,iii,1,2))
8583 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8584 & AEAb1derx(1,lll,kkk,iii,2,2))
8585 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8586 & AEAb2derx(1,lll,kkk,iii,2,2))
8595 C---------------------------------------------------------------------------
8596 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8597 & KK,KKderg,AKA,AKAderg,AKAderx)
8601 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8602 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8603 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8608 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8610 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8613 cd if (lprn) write (2,*) 'In kernel'
8615 cd if (lprn) write (2,*) 'kkk=',kkk
8617 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8618 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8620 cd write (2,*) 'lll=',lll
8621 cd write (2,*) 'iii=1'
8623 cd write (2,'(3(2f10.5),5x)')
8624 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8627 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8628 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8630 cd write (2,*) 'lll=',lll
8631 cd write (2,*) 'iii=2'
8633 cd write (2,'(3(2f10.5),5x)')
8634 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8641 C---------------------------------------------------------------------------
8642 double precision function eello4(i,j,k,l,jj,kk)
8643 implicit real*8 (a-h,o-z)
8644 include 'DIMENSIONS'
8645 include 'DIMENSIONS.ZSCOPT'
8646 include 'COMMON.IOUNITS'
8647 include 'COMMON.CHAIN'
8648 include 'COMMON.DERIV'
8649 include 'COMMON.INTERACT'
8650 include 'COMMON.CONTACTS'
8651 include 'COMMON.TORSION'
8652 include 'COMMON.VAR'
8653 include 'COMMON.GEO'
8654 double precision pizda(2,2),ggg1(3),ggg2(3)
8655 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8659 cd print *,'eello4:',i,j,k,l,jj,kk
8660 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8661 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8662 cold eij=facont_hb(jj,i)
8663 cold ekl=facont_hb(kk,k)
8665 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8667 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8668 gcorr_loc(k-1)=gcorr_loc(k-1)
8669 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8671 gcorr_loc(l-1)=gcorr_loc(l-1)
8672 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8674 gcorr_loc(j-1)=gcorr_loc(j-1)
8675 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8680 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8681 & -EAEAderx(2,2,lll,kkk,iii,1)
8682 cd derx(lll,kkk,iii)=0.0d0
8686 cd gcorr_loc(l-1)=0.0d0
8687 cd gcorr_loc(j-1)=0.0d0
8688 cd gcorr_loc(k-1)=0.0d0
8690 cd write (iout,*)'Contacts have occurred for peptide groups',
8691 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8692 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8693 if (j.lt.nres-1) then
8700 if (l.lt.nres-1) then
8708 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8709 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8710 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8711 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8712 cgrad ghalf=0.5d0*ggg1(ll)
8713 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8714 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8715 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8716 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8717 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8718 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8719 cgrad ghalf=0.5d0*ggg2(ll)
8720 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8721 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8722 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8723 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8724 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8725 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8729 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8734 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8739 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8744 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8748 cd write (2,*) iii,gcorr_loc(iii)
8752 cd write (2,*) 'ekont',ekont
8753 cd write (iout,*) 'eello4',ekont*eel4
8756 C---------------------------------------------------------------------------
8757 double precision function eello5(i,j,k,l,jj,kk)
8758 implicit real*8 (a-h,o-z)
8759 include 'DIMENSIONS'
8760 include 'DIMENSIONS.ZSCOPT'
8761 include 'COMMON.IOUNITS'
8762 include 'COMMON.CHAIN'
8763 include 'COMMON.DERIV'
8764 include 'COMMON.INTERACT'
8765 include 'COMMON.CONTACTS'
8766 include 'COMMON.TORSION'
8767 include 'COMMON.VAR'
8768 include 'COMMON.GEO'
8769 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8770 double precision ggg1(3),ggg2(3)
8771 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8776 C /l\ / \ \ / \ / \ / C
8777 C / \ / \ \ / \ / \ / C
8778 C j| o |l1 | o | o| o | | o |o C
8779 C \ |/k\| |/ \| / |/ \| |/ \| C
8780 C \i/ \ / \ / / \ / \ C
8782 C (I) (II) (III) (IV) C
8784 C eello5_1 eello5_2 eello5_3 eello5_4 C
8786 C Antiparallel chains C
8789 C /j\ / \ \ / \ / \ / C
8790 C / \ / \ \ / \ / \ / C
8791 C j1| o |l | o | o| o | | o |o C
8792 C \ |/k\| |/ \| / |/ \| |/ \| C
8793 C \i/ \ / \ / / \ / \ C
8795 C (I) (II) (III) (IV) C
8797 C eello5_1 eello5_2 eello5_3 eello5_4 C
8799 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8801 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8802 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8807 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8809 itk=itype2loc(itype(k))
8810 itl=itype2loc(itype(l))
8811 itj=itype2loc(itype(j))
8816 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8817 cd & eel5_3_num,eel5_4_num)
8821 derx(lll,kkk,iii)=0.0d0
8825 cd eij=facont_hb(jj,i)
8826 cd ekl=facont_hb(kk,k)
8828 cd write (iout,*)'Contacts have occurred for peptide groups',
8829 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8831 C Contribution from the graph I.
8832 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8833 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8834 call transpose2(EUg(1,1,k),auxmat(1,1))
8835 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8836 vv(1)=pizda(1,1)-pizda(2,2)
8837 vv(2)=pizda(1,2)+pizda(2,1)
8838 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8839 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8841 C Explicit gradient in virtual-dihedral angles.
8842 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8843 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8844 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8845 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8846 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8847 vv(1)=pizda(1,1)-pizda(2,2)
8848 vv(2)=pizda(1,2)+pizda(2,1)
8849 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8850 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8851 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8852 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8853 vv(1)=pizda(1,1)-pizda(2,2)
8854 vv(2)=pizda(1,2)+pizda(2,1)
8856 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8857 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8858 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8860 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8861 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8862 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8864 C Cartesian gradient
8868 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8870 vv(1)=pizda(1,1)-pizda(2,2)
8871 vv(2)=pizda(1,2)+pizda(2,1)
8872 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8873 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8874 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8881 C Contribution from graph II
8882 call transpose2(EE(1,1,k),auxmat(1,1))
8883 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8884 vv(1)=pizda(1,1)+pizda(2,2)
8885 vv(2)=pizda(2,1)-pizda(1,2)
8886 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8887 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8889 C Explicit gradient in virtual-dihedral angles.
8890 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8891 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8892 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8893 vv(1)=pizda(1,1)+pizda(2,2)
8894 vv(2)=pizda(2,1)-pizda(1,2)
8896 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8897 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8898 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8900 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8901 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8902 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8904 C Cartesian gradient
8908 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8910 vv(1)=pizda(1,1)+pizda(2,2)
8911 vv(2)=pizda(2,1)-pizda(1,2)
8912 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8913 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8914 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8923 C Parallel orientation
8924 C Contribution from graph III
8925 call transpose2(EUg(1,1,l),auxmat(1,1))
8926 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8927 vv(1)=pizda(1,1)-pizda(2,2)
8928 vv(2)=pizda(1,2)+pizda(2,1)
8929 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8930 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8932 C Explicit gradient in virtual-dihedral angles.
8933 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8934 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8935 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8936 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8937 vv(1)=pizda(1,1)-pizda(2,2)
8938 vv(2)=pizda(1,2)+pizda(2,1)
8939 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8940 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8941 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8942 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8943 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8944 vv(1)=pizda(1,1)-pizda(2,2)
8945 vv(2)=pizda(1,2)+pizda(2,1)
8946 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8947 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8948 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8949 C Cartesian gradient
8953 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8955 vv(1)=pizda(1,1)-pizda(2,2)
8956 vv(2)=pizda(1,2)+pizda(2,1)
8957 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8958 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8959 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8964 C Contribution from graph IV
8966 call transpose2(EE(1,1,l),auxmat(1,1))
8967 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8968 vv(1)=pizda(1,1)+pizda(2,2)
8969 vv(2)=pizda(2,1)-pizda(1,2)
8970 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8971 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8972 C Explicit gradient in virtual-dihedral angles.
8973 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8974 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8975 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8976 vv(1)=pizda(1,1)+pizda(2,2)
8977 vv(2)=pizda(2,1)-pizda(1,2)
8978 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8979 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8980 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8981 C Cartesian gradient
8985 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8987 vv(1)=pizda(1,1)+pizda(2,2)
8988 vv(2)=pizda(2,1)-pizda(1,2)
8989 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8990 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8991 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8997 C Antiparallel orientation
8998 C Contribution from graph III
9000 call transpose2(EUg(1,1,j),auxmat(1,1))
9001 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9002 vv(1)=pizda(1,1)-pizda(2,2)
9003 vv(2)=pizda(1,2)+pizda(2,1)
9004 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9005 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9007 C Explicit gradient in virtual-dihedral angles.
9008 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9009 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9010 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9011 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9012 vv(1)=pizda(1,1)-pizda(2,2)
9013 vv(2)=pizda(1,2)+pizda(2,1)
9014 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9015 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9016 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9017 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9018 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9019 vv(1)=pizda(1,1)-pizda(2,2)
9020 vv(2)=pizda(1,2)+pizda(2,1)
9021 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9022 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9023 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9024 C Cartesian gradient
9028 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9030 vv(1)=pizda(1,1)-pizda(2,2)
9031 vv(2)=pizda(1,2)+pizda(2,1)
9032 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9033 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9034 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9040 C Contribution from graph IV
9042 call transpose2(EE(1,1,j),auxmat(1,1))
9043 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9044 vv(1)=pizda(1,1)+pizda(2,2)
9045 vv(2)=pizda(2,1)-pizda(1,2)
9046 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9047 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9049 C Explicit gradient in virtual-dihedral angles.
9050 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9051 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9052 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9053 vv(1)=pizda(1,1)+pizda(2,2)
9054 vv(2)=pizda(2,1)-pizda(1,2)
9055 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9056 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9057 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9058 C Cartesian gradient
9062 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9064 vv(1)=pizda(1,1)+pizda(2,2)
9065 vv(2)=pizda(2,1)-pizda(1,2)
9066 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9067 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9068 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9075 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9076 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9077 cd write (2,*) 'ijkl',i,j,k,l
9078 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9079 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9081 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9082 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9083 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9084 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9086 if (j.lt.nres-1) then
9093 if (l.lt.nres-1) then
9103 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9104 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9105 C summed up outside the subrouine as for the other subroutines
9106 C handling long-range interactions. The old code is commented out
9107 C with "cgrad" to keep track of changes.
9109 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9110 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9111 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9112 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9113 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9114 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9115 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9116 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9117 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9118 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9120 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9121 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9122 cgrad ghalf=0.5d0*ggg1(ll)
9124 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9125 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9126 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9127 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9128 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9129 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9130 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9131 cgrad ghalf=0.5d0*ggg2(ll)
9133 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9134 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9135 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9136 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9137 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9138 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9144 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9145 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9150 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9151 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9157 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9162 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9166 cd write (2,*) iii,g_corr5_loc(iii)
9169 cd write (2,*) 'ekont',ekont
9170 cd write (iout,*) 'eello5',ekont*eel5
9173 c--------------------------------------------------------------------------
9174 double precision function eello6(i,j,k,l,jj,kk)
9175 implicit real*8 (a-h,o-z)
9176 include 'DIMENSIONS'
9177 include 'DIMENSIONS.ZSCOPT'
9178 include 'COMMON.IOUNITS'
9179 include 'COMMON.CHAIN'
9180 include 'COMMON.DERIV'
9181 include 'COMMON.INTERACT'
9182 include 'COMMON.CONTACTS'
9183 include 'COMMON.TORSION'
9184 include 'COMMON.VAR'
9185 include 'COMMON.GEO'
9186 include 'COMMON.FFIELD'
9187 double precision ggg1(3),ggg2(3)
9188 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9193 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9201 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9202 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9206 derx(lll,kkk,iii)=0.0d0
9210 cd eij=facont_hb(jj,i)
9211 cd ekl=facont_hb(kk,k)
9217 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9218 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9219 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9220 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9221 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9222 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9224 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9225 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9226 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9227 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9228 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9229 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9233 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9235 C If turn contributions are considered, they will be handled separately.
9236 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9237 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9238 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9239 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9240 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9241 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9242 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9245 if (j.lt.nres-1) then
9252 if (l.lt.nres-1) then
9260 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9261 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9262 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9263 cgrad ghalf=0.5d0*ggg1(ll)
9265 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9266 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9267 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9268 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9269 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9270 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9271 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9272 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9273 cgrad ghalf=0.5d0*ggg2(ll)
9274 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9276 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9277 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9278 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9279 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9280 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9281 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9287 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9288 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9293 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9294 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9300 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9305 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9309 cd write (2,*) iii,g_corr6_loc(iii)
9312 cd write (2,*) 'ekont',ekont
9313 cd write (iout,*) 'eello6',ekont*eel6
9316 c--------------------------------------------------------------------------
9317 double precision function eello6_graph1(i,j,k,l,imat,swap)
9318 implicit real*8 (a-h,o-z)
9319 include 'DIMENSIONS'
9320 include 'DIMENSIONS.ZSCOPT'
9321 include 'COMMON.IOUNITS'
9322 include 'COMMON.CHAIN'
9323 include 'COMMON.DERIV'
9324 include 'COMMON.INTERACT'
9325 include 'COMMON.CONTACTS'
9326 include 'COMMON.TORSION'
9327 include 'COMMON.VAR'
9328 include 'COMMON.GEO'
9329 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9333 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9335 C Parallel Antiparallel C
9341 C \ j|/k\| / \ |/k\|l / C
9346 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9347 itk=itype2loc(itype(k))
9348 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9349 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9350 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9351 call transpose2(EUgC(1,1,k),auxmat(1,1))
9352 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9353 vv1(1)=pizda1(1,1)-pizda1(2,2)
9354 vv1(2)=pizda1(1,2)+pizda1(2,1)
9355 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9356 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9357 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9358 s5=scalar2(vv(1),Dtobr2(1,i))
9359 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9360 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9362 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9363 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9364 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9365 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9366 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9367 & +scalar2(vv(1),Dtobr2der(1,i)))
9368 call matmat2(AEAderg(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 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9372 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9374 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9375 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9376 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9377 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9378 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9380 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9381 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9382 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9383 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9384 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9386 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9387 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9388 vv1(1)=pizda1(1,1)-pizda1(2,2)
9389 vv1(2)=pizda1(1,2)+pizda1(2,1)
9390 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9391 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9392 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9393 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9402 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9403 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9404 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9405 call transpose2(EUgC(1,1,k),auxmat(1,1))
9406 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9408 vv1(1)=pizda1(1,1)-pizda1(2,2)
9409 vv1(2)=pizda1(1,2)+pizda1(2,1)
9410 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9411 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9412 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9413 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9414 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9415 s5=scalar2(vv(1),Dtobr2(1,i))
9416 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9423 c----------------------------------------------------------------------------
9424 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9425 implicit real*8 (a-h,o-z)
9426 include 'DIMENSIONS'
9427 include 'DIMENSIONS.ZSCOPT'
9428 include 'COMMON.IOUNITS'
9429 include 'COMMON.CHAIN'
9430 include 'COMMON.DERIV'
9431 include 'COMMON.INTERACT'
9432 include 'COMMON.CONTACTS'
9433 include 'COMMON.TORSION'
9434 include 'COMMON.VAR'
9435 include 'COMMON.GEO'
9437 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9438 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9441 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9443 C Parallel Antiparallel C
9449 C \ j|/k\| \ |/k\|l C
9454 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9455 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9456 C AL 7/4/01 s1 would occur in the sixth-order moment,
9457 C but not in a cluster cumulant
9459 s1=dip(1,jj,i)*dip(1,kk,k)
9461 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9462 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9463 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9464 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9465 call transpose2(EUg(1,1,k),auxmat(1,1))
9466 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9467 vv(1)=pizda(1,1)-pizda(2,2)
9468 vv(2)=pizda(1,2)+pizda(2,1)
9469 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9470 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9472 eello6_graph2=-(s1+s2+s3+s4)
9474 eello6_graph2=-(s2+s3+s4)
9477 C Derivatives in gamma(i-1)
9481 s1=dipderg(1,jj,i)*dip(1,kk,k)
9483 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9484 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9485 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9486 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9488 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9490 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9492 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9494 C Derivatives in gamma(k-1)
9496 s1=dip(1,jj,i)*dipderg(1,kk,k)
9498 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9499 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9500 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9501 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9502 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9503 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9504 vv(1)=pizda(1,1)-pizda(2,2)
9505 vv(2)=pizda(1,2)+pizda(2,1)
9506 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9508 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9510 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9512 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9513 C Derivatives in gamma(j-1) or gamma(l-1)
9516 s1=dipderg(3,jj,i)*dip(1,kk,k)
9518 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9519 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9520 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9521 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9522 vv(1)=pizda(1,1)-pizda(2,2)
9523 vv(2)=pizda(1,2)+pizda(2,1)
9524 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9527 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9529 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9532 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9533 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9535 C Derivatives in gamma(l-1) or gamma(j-1)
9538 s1=dip(1,jj,i)*dipderg(3,kk,k)
9540 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9541 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9542 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9543 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9544 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9545 vv(1)=pizda(1,1)-pizda(2,2)
9546 vv(2)=pizda(1,2)+pizda(2,1)
9547 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9550 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9552 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9555 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9556 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9558 C Cartesian derivatives.
9560 write (2,*) 'In eello6_graph2'
9562 write (2,*) 'iii=',iii
9564 write (2,*) 'kkk=',kkk
9566 write (2,'(3(2f10.5),5x)')
9567 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9577 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9579 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9582 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9584 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9585 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9587 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9588 call transpose2(EUg(1,1,k),auxmat(1,1))
9589 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9591 vv(1)=pizda(1,1)-pizda(2,2)
9592 vv(2)=pizda(1,2)+pizda(2,1)
9593 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9594 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9596 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9598 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9601 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9603 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9611 c----------------------------------------------------------------------------
9612 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9613 implicit real*8 (a-h,o-z)
9614 include 'DIMENSIONS'
9615 include 'DIMENSIONS.ZSCOPT'
9616 include 'COMMON.IOUNITS'
9617 include 'COMMON.CHAIN'
9618 include 'COMMON.DERIV'
9619 include 'COMMON.INTERACT'
9620 include 'COMMON.CONTACTS'
9621 include 'COMMON.TORSION'
9622 include 'COMMON.VAR'
9623 include 'COMMON.GEO'
9624 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9626 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9628 C Parallel Antiparallel C
9634 C j|/k\| / |/k\|l / C
9639 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9641 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9642 C energy moment and not to the cluster cumulant.
9643 iti=itortyp(itype(i))
9644 if (j.lt.nres-1) then
9645 itj1=itype2loc(itype(j+1))
9649 itk=itype2loc(itype(k))
9650 itk1=itype2loc(itype(k+1))
9651 if (l.lt.nres-1) then
9652 itl1=itype2loc(itype(l+1))
9657 s1=dip(4,jj,i)*dip(4,kk,k)
9659 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9660 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9661 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9662 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9663 call transpose2(EE(1,1,k),auxmat(1,1))
9664 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9665 vv(1)=pizda(1,1)+pizda(2,2)
9666 vv(2)=pizda(2,1)-pizda(1,2)
9667 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9668 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9669 cd & "sum",-(s2+s3+s4)
9671 eello6_graph3=-(s1+s2+s3+s4)
9673 eello6_graph3=-(s2+s3+s4)
9676 C Derivatives in gamma(k-1)
9678 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9679 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9680 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9681 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9682 C Derivatives in gamma(l-1)
9683 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9684 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9685 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9686 vv(1)=pizda(1,1)+pizda(2,2)
9687 vv(2)=pizda(2,1)-pizda(1,2)
9688 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9689 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9690 C Cartesian derivatives.
9696 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9698 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9701 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9703 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9704 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9706 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9707 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9709 vv(1)=pizda(1,1)+pizda(2,2)
9710 vv(2)=pizda(2,1)-pizda(1,2)
9711 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9713 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9715 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9718 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9720 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9722 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9729 c----------------------------------------------------------------------------
9730 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9731 implicit real*8 (a-h,o-z)
9732 include 'DIMENSIONS'
9733 include 'DIMENSIONS.ZSCOPT'
9734 include 'COMMON.IOUNITS'
9735 include 'COMMON.CHAIN'
9736 include 'COMMON.DERIV'
9737 include 'COMMON.INTERACT'
9738 include 'COMMON.CONTACTS'
9739 include 'COMMON.TORSION'
9740 include 'COMMON.VAR'
9741 include 'COMMON.GEO'
9742 include 'COMMON.FFIELD'
9743 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9744 & auxvec1(2),auxmat1(2,2)
9746 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9748 C Parallel Antiparallel C
9754 C \ j|/k\| \ |/k\|l C
9759 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9761 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9762 C energy moment and not to the cluster cumulant.
9763 cd write (2,*) 'eello_graph4: wturn6',wturn6
9764 iti=itype2loc(itype(i))
9765 itj=itype2loc(itype(j))
9766 if (j.lt.nres-1) then
9767 itj1=itype2loc(itype(j+1))
9771 itk=itype2loc(itype(k))
9772 if (k.lt.nres-1) then
9773 itk1=itype2loc(itype(k+1))
9777 itl=itype2loc(itype(l))
9778 if (l.lt.nres-1) then
9779 itl1=itype2loc(itype(l+1))
9783 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9784 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9785 cd & ' itl',itl,' itl1',itl1
9788 s1=dip(3,jj,i)*dip(3,kk,k)
9790 s1=dip(2,jj,j)*dip(2,kk,l)
9793 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9794 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9796 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9797 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9799 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9800 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9802 call transpose2(EUg(1,1,k),auxmat(1,1))
9803 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9804 vv(1)=pizda(1,1)-pizda(2,2)
9805 vv(2)=pizda(2,1)+pizda(1,2)
9806 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9807 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9809 eello6_graph4=-(s1+s2+s3+s4)
9811 eello6_graph4=-(s2+s3+s4)
9813 C Derivatives in gamma(i-1)
9818 s1=dipderg(2,jj,i)*dip(3,kk,k)
9820 s1=dipderg(4,jj,j)*dip(2,kk,l)
9823 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9825 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9826 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9828 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9829 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9831 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9832 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9833 cd write (2,*) 'turn6 derivatives'
9835 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9837 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9841 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9843 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9847 C Derivatives in gamma(k-1)
9850 s1=dip(3,jj,i)*dipderg(2,kk,k)
9852 s1=dip(2,jj,j)*dipderg(4,kk,l)
9855 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9856 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9858 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9859 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9861 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9862 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9864 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9865 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9866 vv(1)=pizda(1,1)-pizda(2,2)
9867 vv(2)=pizda(2,1)+pizda(1,2)
9868 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9869 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9871 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9873 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9877 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9879 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9882 C Derivatives in gamma(j-1) or gamma(l-1)
9883 if (l.eq.j+1 .and. l.gt.1) then
9884 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9885 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9886 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9887 vv(1)=pizda(1,1)-pizda(2,2)
9888 vv(2)=pizda(2,1)+pizda(1,2)
9889 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9890 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9891 else if (j.gt.1) then
9892 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9893 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9894 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9895 vv(1)=pizda(1,1)-pizda(2,2)
9896 vv(2)=pizda(2,1)+pizda(1,2)
9897 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9898 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9899 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9901 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9904 C Cartesian derivatives.
9911 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9913 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9917 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9919 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9923 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9925 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9927 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9928 & b1(1,j+1),auxvec(1))
9929 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9931 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9932 & b1(1,l+1),auxvec(1))
9933 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9935 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9937 vv(1)=pizda(1,1)-pizda(2,2)
9938 vv(2)=pizda(2,1)+pizda(1,2)
9939 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9941 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9943 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9946 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9949 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9952 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9954 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9956 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9960 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9962 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9965 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9967 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9976 c----------------------------------------------------------------------------
9977 double precision function eello_turn6(i,jj,kk)
9978 implicit real*8 (a-h,o-z)
9979 include 'DIMENSIONS'
9980 include 'DIMENSIONS.ZSCOPT'
9981 include 'COMMON.IOUNITS'
9982 include 'COMMON.CHAIN'
9983 include 'COMMON.DERIV'
9984 include 'COMMON.INTERACT'
9985 include 'COMMON.CONTACTS'
9986 include 'COMMON.TORSION'
9987 include 'COMMON.VAR'
9988 include 'COMMON.GEO'
9989 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9990 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9992 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9993 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9994 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9995 C the respective energy moment and not to the cluster cumulant.
10004 iti=itype2loc(itype(i))
10005 itk=itype2loc(itype(k))
10006 itk1=itype2loc(itype(k+1))
10007 itl=itype2loc(itype(l))
10008 itj=itype2loc(itype(j))
10009 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10010 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10011 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10016 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10018 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10022 derx_turn(lll,kkk,iii)=0.0d0
10029 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10031 cd write (2,*) 'eello6_5',eello6_5
10033 call transpose2(AEA(1,1,1),auxmat(1,1))
10034 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10035 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10036 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10038 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10039 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10040 s2 = scalar2(b1(1,k),vtemp1(1))
10042 call transpose2(AEA(1,1,2),atemp(1,1))
10043 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10044 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
10045 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
10047 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10048 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10049 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10051 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10052 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10053 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10054 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10055 ss13 = scalar2(b1(1,k),vtemp4(1))
10056 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10058 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10064 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10065 C Derivatives in gamma(i+2)
10066 if (calc_grad) then
10070 call transpose2(AEA(1,1,1),auxmatd(1,1))
10071 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10072 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10073 call transpose2(AEAderg(1,1,2),atempd(1,1))
10074 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10075 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
10077 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10078 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10079 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10085 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10086 C Derivatives in gamma(i+3)
10088 call transpose2(AEA(1,1,1),auxmatd(1,1))
10089 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10090 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10091 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10093 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10094 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10095 s2d = scalar2(b1(1,k),vtemp1d(1))
10097 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
10098 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
10100 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10102 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10103 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10104 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10112 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10113 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10115 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10116 & -0.5d0*ekont*(s2d+s12d)
10118 C Derivatives in gamma(i+4)
10119 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10120 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10121 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10123 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10124 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10125 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10133 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10135 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10137 C Derivatives in gamma(i+5)
10139 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10140 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10141 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10143 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10144 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10145 s2d = scalar2(b1(1,k),vtemp1d(1))
10147 call transpose2(AEA(1,1,2),atempd(1,1))
10148 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10149 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
10151 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10152 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10154 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10155 ss13d = scalar2(b1(1,k),vtemp4d(1))
10156 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10164 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10165 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10167 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10168 & -0.5d0*ekont*(s2d+s12d)
10170 C Cartesian derivatives
10175 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10176 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10177 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10179 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10180 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10182 s2d = scalar2(b1(1,k),vtemp1d(1))
10184 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10185 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10186 s8d = -(atempd(1,1)+atempd(2,2))*
10187 & scalar2(cc(1,1,l),vtemp2(1))
10189 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10191 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10192 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10199 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10200 & - 0.5d0*(s1d+s2d)
10202 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10206 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10207 & - 0.5d0*(s8d+s12d)
10209 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10218 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10219 & achuj_tempd(1,1))
10220 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10221 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10222 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10223 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10224 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10226 ss13d = scalar2(b1(1,k),vtemp4d(1))
10227 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10228 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10232 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10233 cd & 16*eel_turn6_num
10235 if (j.lt.nres-1) then
10242 if (l.lt.nres-1) then
10250 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10251 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10252 cgrad ghalf=0.5d0*ggg1(ll)
10254 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10255 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10256 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10257 & +ekont*derx_turn(ll,2,1)
10258 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10259 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10260 & +ekont*derx_turn(ll,4,1)
10261 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10262 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10263 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10264 cgrad ghalf=0.5d0*ggg2(ll)
10266 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10267 & +ekont*derx_turn(ll,2,2)
10268 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10269 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10270 & +ekont*derx_turn(ll,4,2)
10271 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10272 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10273 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10278 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10283 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10289 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10294 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10298 cd write (2,*) iii,g_corr6_loc(iii)
10301 eello_turn6=ekont*eel_turn6
10302 cd write (2,*) 'ekont',ekont
10303 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10307 crc-------------------------------------------------
10308 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10309 subroutine Eliptransfer(eliptran)
10310 implicit real*8 (a-h,o-z)
10311 include 'DIMENSIONS'
10312 include 'DIMENSIONS.ZSCOPT'
10313 include 'COMMON.GEO'
10314 include 'COMMON.VAR'
10315 include 'COMMON.LOCAL'
10316 include 'COMMON.CHAIN'
10317 include 'COMMON.DERIV'
10318 include 'COMMON.INTERACT'
10319 include 'COMMON.IOUNITS'
10320 include 'COMMON.CALC'
10321 include 'COMMON.CONTROL'
10322 include 'COMMON.SPLITELE'
10323 include 'COMMON.SBRIDGE'
10324 C this is done by Adasko
10325 C print *,"wchodze"
10326 C structure of box:
10328 C--bordliptop-- buffore starts
10329 C--bufliptop--- here true lipid starts
10331 C--buflipbot--- lipid ends buffore starts
10332 C--bordlipbot--buffore ends
10336 if (itype(i).eq.ntyp1) cycle
10338 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10339 if (positi.le.0) positi=positi+boxzsize
10341 C first for peptide groups
10342 c for each residue check if it is in lipid or lipid water border area
10343 if ((positi.gt.bordlipbot)
10344 &.and.(positi.lt.bordliptop)) then
10345 C the energy transfer exist
10346 if (positi.lt.buflipbot) then
10347 C what fraction I am in
10349 & ((positi-bordlipbot)/lipbufthick)
10350 C lipbufthick is thickenes of lipid buffore
10351 sslip=sscalelip(fracinbuf)
10352 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10353 eliptran=eliptran+sslip*pepliptran
10354 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10355 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10356 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10357 elseif (positi.gt.bufliptop) then
10358 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10359 sslip=sscalelip(fracinbuf)
10360 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10361 eliptran=eliptran+sslip*pepliptran
10362 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10363 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10364 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10365 C print *, "doing sscalefor top part"
10366 C print *,i,sslip,fracinbuf,ssgradlip
10368 eliptran=eliptran+pepliptran
10369 C print *,"I am in true lipid"
10372 C eliptran=elpitran+0.0 ! I am in water
10375 C print *, "nic nie bylo w lipidzie?"
10376 C now multiply all by the peptide group transfer factor
10377 C eliptran=eliptran*pepliptran
10378 C now the same for side chains
10381 if (itype(i).eq.ntyp1) cycle
10382 positi=(mod(c(3,i+nres),boxzsize))
10383 if (positi.le.0) positi=positi+boxzsize
10384 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10385 c for each residue check if it is in lipid or lipid water border area
10386 C respos=mod(c(3,i+nres),boxzsize)
10387 C print *,positi,bordlipbot,buflipbot
10388 if ((positi.gt.bordlipbot)
10389 & .and.(positi.lt.bordliptop)) then
10390 C the energy transfer exist
10391 if (positi.lt.buflipbot) then
10393 & ((positi-bordlipbot)/lipbufthick)
10394 C lipbufthick is thickenes of lipid buffore
10395 sslip=sscalelip(fracinbuf)
10396 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10397 eliptran=eliptran+sslip*liptranene(itype(i))
10398 gliptranx(3,i)=gliptranx(3,i)
10399 &+ssgradlip*liptranene(itype(i))
10400 gliptranc(3,i-1)= gliptranc(3,i-1)
10401 &+ssgradlip*liptranene(itype(i))
10402 C print *,"doing sccale for lower part"
10403 elseif (positi.gt.bufliptop) then
10405 &((bordliptop-positi)/lipbufthick)
10406 sslip=sscalelip(fracinbuf)
10407 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10408 eliptran=eliptran+sslip*liptranene(itype(i))
10409 gliptranx(3,i)=gliptranx(3,i)
10410 &+ssgradlip*liptranene(itype(i))
10411 gliptranc(3,i-1)= gliptranc(3,i-1)
10412 &+ssgradlip*liptranene(itype(i))
10413 C print *, "doing sscalefor top part",sslip,fracinbuf
10415 eliptran=eliptran+liptranene(itype(i))
10416 C print *,"I am in true lipid"
10418 endif ! if in lipid or buffor
10420 C eliptran=elpitran+0.0 ! I am in water
10426 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10428 SUBROUTINE MATVEC2(A1,V1,V2)
10429 implicit real*8 (a-h,o-z)
10430 include 'DIMENSIONS'
10431 DIMENSION A1(2,2),V1(2),V2(2)
10435 c 3 VI=VI+A1(I,K)*V1(K)
10439 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10440 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10445 C---------------------------------------
10446 SUBROUTINE MATMAT2(A1,A2,A3)
10447 implicit real*8 (a-h,o-z)
10448 include 'DIMENSIONS'
10449 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10450 c DIMENSION AI3(2,2)
10454 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10460 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10461 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10462 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10463 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10471 c-------------------------------------------------------------------------
10472 double precision function scalar2(u,v)
10474 double precision u(2),v(2)
10475 double precision sc
10477 scalar2=u(1)*v(1)+u(2)*v(2)
10481 C-----------------------------------------------------------------------------
10483 subroutine transpose2(a,at)
10485 double precision a(2,2),at(2,2)
10492 c--------------------------------------------------------------------------
10493 subroutine transpose(n,a,at)
10496 double precision a(n,n),at(n,n)
10504 C---------------------------------------------------------------------------
10505 subroutine prodmat3(a1,a2,kk,transp,prod)
10508 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10510 crc double precision auxmat(2,2),prod_(2,2)
10513 crc call transpose2(kk(1,1),auxmat(1,1))
10514 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10515 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10517 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10518 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10519 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10520 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10521 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10522 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10523 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10524 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10527 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10528 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10530 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10531 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10532 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10533 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10534 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10535 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10536 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10537 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10540 c call transpose2(a2(1,1),a2t(1,1))
10543 crc print *,((prod_(i,j),i=1,2),j=1,2)
10544 crc print *,((prod(i,j),i=1,2),j=1,2)
10548 C-----------------------------------------------------------------------------
10549 double precision function scalar(u,v)
10551 double precision u(3),v(3)
10552 double precision sc
10561 C-----------------------------------------------------------------------
10562 double precision function sscale(r)
10563 double precision r,gamm
10564 include "COMMON.SPLITELE"
10565 if(r.lt.r_cut-rlamb) then
10567 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10568 gamm=(r-(r_cut-rlamb))/rlamb
10569 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10575 C-----------------------------------------------------------------------
10576 C-----------------------------------------------------------------------
10577 double precision function sscagrad(r)
10578 double precision r,gamm
10579 include "COMMON.SPLITELE"
10580 if(r.lt.r_cut-rlamb) then
10582 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10583 gamm=(r-(r_cut-rlamb))/rlamb
10584 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
10590 C-----------------------------------------------------------------------
10591 C-----------------------------------------------------------------------
10592 double precision function sscalelip(r)
10593 double precision r,gamm
10594 include "COMMON.SPLITELE"
10595 C if(r.lt.r_cut-rlamb) then
10597 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10598 C gamm=(r-(r_cut-rlamb))/rlamb
10599 sscalelip=1.0d0+r*r*(2*r-3.0d0)
10605 C-----------------------------------------------------------------------
10606 double precision function sscagradlip(r)
10607 double precision r,gamm
10608 include "COMMON.SPLITELE"
10609 C if(r.lt.r_cut-rlamb) then
10611 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10612 C gamm=(r-(r_cut-rlamb))/rlamb
10613 sscagradlip=r*(6*r-6.0d0)
10620 C-----------------------------------------------------------------------
10621 subroutine set_shield_fac
10622 implicit real*8 (a-h,o-z)
10623 include 'DIMENSIONS'
10624 include 'DIMENSIONS.ZSCOPT'
10625 include 'COMMON.CHAIN'
10626 include 'COMMON.DERIV'
10627 include 'COMMON.IOUNITS'
10628 include 'COMMON.SHIELD'
10629 include 'COMMON.INTERACT'
10630 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10631 double precision div77_81/0.974996043d0/,
10632 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10634 C the vector between center of side_chain and peptide group
10635 double precision pep_side(3),long,side_calf(3),
10636 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10637 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10638 C the line belowe needs to be changed for FGPROC>1
10640 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10642 Cif there two consequtive dummy atoms there is no peptide group between them
10643 C the line below has to be changed for FGPROC>1
10646 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10650 C first lets set vector conecting the ithe side-chain with kth side-chain
10651 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10652 C pep_side(j)=2.0d0
10653 C and vector conecting the side-chain with its proper calfa
10654 side_calf(j)=c(j,k+nres)-c(j,k)
10655 C side_calf(j)=2.0d0
10656 pept_group(j)=c(j,i)-c(j,i+1)
10657 C lets have their lenght
10658 dist_pep_side=pep_side(j)**2+dist_pep_side
10659 dist_side_calf=dist_side_calf+side_calf(j)**2
10660 dist_pept_group=dist_pept_group+pept_group(j)**2
10662 dist_pep_side=dsqrt(dist_pep_side)
10663 dist_pept_group=dsqrt(dist_pept_group)
10664 dist_side_calf=dsqrt(dist_side_calf)
10666 pep_side_norm(j)=pep_side(j)/dist_pep_side
10667 side_calf_norm(j)=dist_side_calf
10669 C now sscale fraction
10670 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10671 C print *,buff_shield,"buff"
10673 if (sh_frac_dist.le.0.0) cycle
10674 C If we reach here it means that this side chain reaches the shielding sphere
10675 C Lets add him to the list for gradient
10676 ishield_list(i)=ishield_list(i)+1
10677 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10678 C this list is essential otherwise problem would be O3
10679 shield_list(ishield_list(i),i)=k
10680 C Lets have the sscale value
10681 if (sh_frac_dist.gt.1.0) then
10682 scale_fac_dist=1.0d0
10684 sh_frac_dist_grad(j)=0.0d0
10687 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10688 & *(2.0*sh_frac_dist-3.0d0)
10689 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
10690 & /dist_pep_side/buff_shield*0.5
10691 C remember for the final gradient multiply sh_frac_dist_grad(j)
10692 C for side_chain by factor -2 !
10694 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10695 C print *,"jestem",scale_fac_dist,fac_help_scale,
10696 C & sh_frac_dist_grad(j)
10699 C if ((i.eq.3).and.(k.eq.2)) then
10700 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
10704 C this is what is now we have the distance scaling now volume...
10705 short=short_r_sidechain(itype(k))
10706 long=long_r_sidechain(itype(k))
10707 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
10710 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
10711 C costhet_fac=0.0d0
10713 costhet_grad(j)=costhet_fac*pep_side(j)
10715 C remember for the final gradient multiply costhet_grad(j)
10716 C for side_chain by factor -2 !
10717 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10718 C pep_side0pept_group is vector multiplication
10719 pep_side0pept_group=0.0
10721 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10723 cosalfa=(pep_side0pept_group/
10724 & (dist_pep_side*dist_side_calf))
10725 fac_alfa_sin=1.0-cosalfa**2
10726 fac_alfa_sin=dsqrt(fac_alfa_sin)
10727 rkprim=fac_alfa_sin*(long-short)+short
10729 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
10730 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
10733 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10734 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10735 &*(long-short)/fac_alfa_sin*cosalfa/
10736 &((dist_pep_side*dist_side_calf))*
10737 &((side_calf(j))-cosalfa*
10738 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10740 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10741 &*(long-short)/fac_alfa_sin*cosalfa
10742 &/((dist_pep_side*dist_side_calf))*
10744 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10747 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10750 C now the gradient...
10751 C grad_shield is gradient of Calfa for peptide groups
10752 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
10754 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
10755 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
10757 grad_shield(j,i)=grad_shield(j,i)
10758 C gradient po skalowaniu
10759 & +(sh_frac_dist_grad(j)
10760 C gradient po costhet
10761 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10762 &-scale_fac_dist*(cosphi_grad_long(j))
10763 &/(1.0-cosphi) )*div77_81
10765 C grad_shield_side is Cbeta sidechain gradient
10766 grad_shield_side(j,ishield_list(i),i)=
10767 & (sh_frac_dist_grad(j)*(-2.0d0)
10768 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10769 & +scale_fac_dist*(cosphi_grad_long(j))
10770 & *2.0d0/(1.0-cosphi))
10771 & *div77_81*VofOverlap
10773 grad_shield_loc(j,ishield_list(i),i)=
10774 & scale_fac_dist*cosphi_grad_loc(j)
10775 & *2.0d0/(1.0-cosphi)
10776 & *div77_81*VofOverlap
10778 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10780 fac_shield(i)=VolumeTotal*div77_81+div4_81
10781 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10785 C--------------------------------------------------------------------------
10786 C first for shielding is setting of function of side-chains
10787 subroutine set_shield_fac2
10788 implicit real*8 (a-h,o-z)
10789 include 'DIMENSIONS'
10790 include 'DIMENSIONS.ZSCOPT'
10791 include 'COMMON.CHAIN'
10792 include 'COMMON.DERIV'
10793 include 'COMMON.IOUNITS'
10794 include 'COMMON.SHIELD'
10795 include 'COMMON.INTERACT'
10796 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10797 double precision div77_81/0.974996043d0/,
10798 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10800 C the vector between center of side_chain and peptide group
10801 double precision pep_side(3),long,side_calf(3),
10802 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10803 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10804 C the line belowe needs to be changed for FGPROC>1
10806 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10808 Cif there two consequtive dummy atoms there is no peptide group between them
10809 C the line below has to be changed for FGPROC>1
10812 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10816 C first lets set vector conecting the ithe side-chain with kth side-chain
10817 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10818 C pep_side(j)=2.0d0
10819 C and vector conecting the side-chain with its proper calfa
10820 side_calf(j)=c(j,k+nres)-c(j,k)
10821 C side_calf(j)=2.0d0
10822 pept_group(j)=c(j,i)-c(j,i+1)
10823 C lets have their lenght
10824 dist_pep_side=pep_side(j)**2+dist_pep_side
10825 dist_side_calf=dist_side_calf+side_calf(j)**2
10826 dist_pept_group=dist_pept_group+pept_group(j)**2
10828 dist_pep_side=dsqrt(dist_pep_side)
10829 dist_pept_group=dsqrt(dist_pept_group)
10830 dist_side_calf=dsqrt(dist_side_calf)
10832 pep_side_norm(j)=pep_side(j)/dist_pep_side
10833 side_calf_norm(j)=dist_side_calf
10835 C now sscale fraction
10836 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10837 C print *,buff_shield,"buff"
10839 if (sh_frac_dist.le.0.0) cycle
10840 C If we reach here it means that this side chain reaches the shielding sphere
10841 C Lets add him to the list for gradient
10842 ishield_list(i)=ishield_list(i)+1
10843 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10844 C this list is essential otherwise problem would be O3
10845 shield_list(ishield_list(i),i)=k
10846 C Lets have the sscale value
10847 if (sh_frac_dist.gt.1.0) then
10848 scale_fac_dist=1.0d0
10850 sh_frac_dist_grad(j)=0.0d0
10853 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10854 & *(2.0d0*sh_frac_dist-3.0d0)
10855 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
10856 & /dist_pep_side/buff_shield*0.5d0
10857 C remember for the final gradient multiply sh_frac_dist_grad(j)
10858 C for side_chain by factor -2 !
10860 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10861 C sh_frac_dist_grad(j)=0.0d0
10862 C scale_fac_dist=1.0d0
10863 C print *,"jestem",scale_fac_dist,fac_help_scale,
10864 C & sh_frac_dist_grad(j)
10867 C this is what is now we have the distance scaling now volume...
10868 short=short_r_sidechain(itype(k))
10869 long=long_r_sidechain(itype(k))
10870 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
10871 sinthet=short/dist_pep_side*costhet
10875 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
10876 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
10877 C & -short/dist_pep_side**2/costhet)
10878 C costhet_fac=0.0d0
10880 costhet_grad(j)=costhet_fac*pep_side(j)
10882 C remember for the final gradient multiply costhet_grad(j)
10883 C for side_chain by factor -2 !
10884 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10885 C pep_side0pept_group is vector multiplication
10886 pep_side0pept_group=0.0d0
10888 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10890 cosalfa=(pep_side0pept_group/
10891 & (dist_pep_side*dist_side_calf))
10892 fac_alfa_sin=1.0d0-cosalfa**2
10893 fac_alfa_sin=dsqrt(fac_alfa_sin)
10894 rkprim=fac_alfa_sin*(long-short)+short
10898 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
10900 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
10901 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
10902 & dist_pep_side**2)
10905 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10906 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10907 &*(long-short)/fac_alfa_sin*cosalfa/
10908 &((dist_pep_side*dist_side_calf))*
10909 &((side_calf(j))-cosalfa*
10910 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10911 C cosphi_grad_long(j)=0.0d0
10912 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10913 &*(long-short)/fac_alfa_sin*cosalfa
10914 &/((dist_pep_side*dist_side_calf))*
10916 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10917 C cosphi_grad_loc(j)=0.0d0
10919 C print *,sinphi,sinthet
10920 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
10923 C now the gradient...
10925 grad_shield(j,i)=grad_shield(j,i)
10926 C gradient po skalowaniu
10927 & +(sh_frac_dist_grad(j)*VofOverlap
10928 C gradient po costhet
10929 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
10930 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10931 & sinphi/sinthet*costhet*costhet_grad(j)
10932 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10934 C grad_shield_side is Cbeta sidechain gradient
10935 grad_shield_side(j,ishield_list(i),i)=
10936 & (sh_frac_dist_grad(j)*(-2.0d0)
10938 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10939 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10940 & sinphi/sinthet*costhet*costhet_grad(j)
10941 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10944 grad_shield_loc(j,ishield_list(i),i)=
10945 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10946 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
10947 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
10951 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10953 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
10954 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10955 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
10959 C--------------------------------------------------------------------------
10960 double precision function tschebyshev(m,n,x,y)
10962 include "DIMENSIONS"
10964 double precision x(n),y,yy(0:maxvar),aux
10965 c Tschebyshev polynomial. Note that the first term is omitted
10966 c m=0: the constant term is included
10967 c m=1: the constant term is not included
10971 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
10980 C--------------------------------------------------------------------------
10981 double precision function gradtschebyshev(m,n,x,y)
10983 include "DIMENSIONS"
10985 double precision x(n+1),y,yy(0:maxvar),aux
10986 c Tschebyshev polynomial. Note that the first term is omitted
10987 c m=0: the constant term is included
10988 c m=1: the constant term is not included
10992 yy(i)=2*y*yy(i-1)-yy(i-2)
10996 aux=aux+x(i+1)*yy(i)*(i+1)
10997 C print *, x(i+1),yy(i),i
10999 gradtschebyshev=aux