1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
9 cMS$ATTRIBUTES C :: proc_proc
12 include 'COMMON.IOUNITS'
13 double precision energia(0:max_ene),energia1(0:max_ene+1)
14 include 'COMMON.FFIELD'
15 include 'COMMON.DERIV'
16 include 'COMMON.INTERACT'
17 include 'COMMON.SBRIDGE'
18 include 'COMMON.CHAIN'
19 include 'COMMON.SHIELD'
20 include 'COMMON.CONTROL'
21 include 'COMMON.TORCNSTR'
23 double precision fact(6)
24 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
26 cd print *,'nnt=',nnt,' nct=',nct
28 C Compute the side-chain and electrostatic interaction energy
30 goto (101,102,103,104,105) ipot
31 C Lennard-Jones potential.
32 101 call elj(evdw,evdw_t)
33 cd print '(a)','Exit ELJ'
35 C Lennard-Jones-Kihara potential (shifted).
36 102 call eljk(evdw,evdw_t)
38 C Berne-Pechukas potential (dilated LJ, angular dependence).
39 103 call ebp(evdw,evdw_t)
41 C Gay-Berne potential (shifted LJ, angular dependence).
42 104 call egb(evdw,evdw_t)
44 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
45 105 call egbv(evdw,evdw_t)
47 C Calculate electrostatic (H-bonding) energy of the main chain.
50 c write (iout,*) "Sidechain"
53 if (shield_mode.eq.1) then
55 else if (shield_mode.eq.2) then
58 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
59 c write(iout,*) 'po eelec'
62 C Calculate excluded-volume interaction energy between peptide groups
65 call escp(evdw2,evdw2_14)
67 c Calculate the bond-stretching energy
71 C write (iout,*) "estr",estr
73 C Calculate the disulfide-bridge and other energy and the contributions
74 C from other distance constraints.
75 cd print *,'Calling EHPB'
77 cd print *,'EHPB exitted succesfully.'
79 C Calculate the virtual-bond-angle energy.
81 C print *,'Bend energy finished.'
83 if (tor_mode.eq.0) then
86 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
94 if (with_theta_constr) call etheta_constr(ethetacnstr)
95 c call ebend(ebe,ethetacnstr)
96 cd print *,'Bend energy finished.'
98 C Calculate the SC local energy.
101 C print *,'SCLOC energy finished.'
103 C Calculate the virtual-bond torsional energy.
105 if (wtor.gt.0.0d0) then
106 if (tor_mode.eq.0) then
107 call etor(etors,fact(1))
109 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
111 call etor_kcc(etors,fact(1))
117 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
118 c print *,"Processor",myrank," computed Utor"
120 C 6/23/01 Calculate double-torsional energy
122 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
123 call etor_d(etors_d,fact(2))
127 c print *,"Processor",myrank," computed Utord"
129 call eback_sc_corr(esccor)
131 if (wliptran.gt.0) then
132 call Eliptransfer(eliptran)
136 C 12/1/95 Multi-body terms
140 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
141 & .or. wturn6.gt.0.0d0) then
142 c write(iout,*)"calling multibody_eello"
143 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
144 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
145 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
152 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
153 c write (iout,*) "Calling multibody_hbond"
154 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
156 c write (iout,*) "NSAXS",nsaxs
157 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
158 call e_saxs(Esaxs_constr)
159 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
160 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
161 call e_saxsC(Esaxs_constr)
162 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
166 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
167 if (constr_homology.ge.1) then
168 call e_modeller(ehomology_constr)
170 ehomology_constr=0.0d0
173 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
175 C BARTEK for dfa test!
176 if (wdfa_dist.gt.0) call edfad(edfadis)
177 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
178 if (wdfa_tor.gt.0) call edfat(edfator)
179 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
180 if (wdfa_nei.gt.0) call edfan(edfanei)
181 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
182 if (wdfa_beta.gt.0) call edfab(edfabet)
183 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
187 if (shield_mode.gt.0) then
188 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
190 & +fact(1)*wvdwpp*evdw1
191 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
192 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
193 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
194 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
195 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
196 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
197 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
198 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
201 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
203 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
204 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
205 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
206 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
207 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
208 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
209 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
210 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
214 if (shield_mode.gt.0) then
215 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
216 & +welec*fact(1)*(ees+evdw1)
217 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
218 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
219 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
220 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
221 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
222 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
223 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
224 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
227 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
228 & +welec*fact(1)*(ees+evdw1)
229 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
230 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
231 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
232 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
233 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
234 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
235 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
236 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
243 energia(2)=evdw2-evdw2_14
260 energia(8)=eello_turn3
261 energia(9)=eello_turn4
270 energia(20)=edihcnstr
273 energia(24)=ethetacnstr
274 energia(26)=esaxs_constr
275 energia(27)=ehomology_constr
283 if (isnan(etot).ne.0) energia(0)=1.0d+99
285 if (isnan(etot)) energia(0)=1.0d+99
290 idumm=proc_proc(etot,i)
292 call proc_proc(etot,i)
294 if(i.eq.1)energia(0)=1.0d+99
300 call enerprint(energia,fact)
304 C Sum up the components of the Cartesian gradient.
309 if (shield_mode.eq.0) then
310 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
311 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
313 & wstrain*ghpbc(j,i)+
314 & wcorr*fact(3)*gradcorr(j,i)+
315 & wel_loc*fact(2)*gel_loc(j,i)+
316 & wturn3*fact(2)*gcorr3_turn(j,i)+
317 & wturn4*fact(3)*gcorr4_turn(j,i)+
318 & wcorr5*fact(4)*gradcorr5(j,i)+
319 & wcorr6*fact(5)*gradcorr6(j,i)+
320 & wturn6*fact(5)*gcorr6_turn(j,i)+
321 & wsccor*fact(2)*gsccorc(j,i)
322 & +wliptran*gliptranc(j,i)+
323 & wdfa_dist*gdfad(j,i)+
324 & wdfa_tor*gdfat(j,i)+
325 & wdfa_nei*gdfan(j,i)+
326 & wdfa_beta*gdfab(j,i)
327 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
329 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
330 & wsccor*fact(2)*gsccorx(j,i)
331 & +wliptran*gliptranx(j,i)
333 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
334 & +fact(1)*wscp*gvdwc_scp(j,i)+
335 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
337 & wstrain*ghpbc(j,i)+
338 & wcorr*fact(3)*gradcorr(j,i)+
339 & wel_loc*fact(2)*gel_loc(j,i)+
340 & wturn3*fact(2)*gcorr3_turn(j,i)+
341 & wturn4*fact(3)*gcorr4_turn(j,i)+
342 & wcorr5*fact(4)*gradcorr5(j,i)+
343 & wcorr6*fact(5)*gradcorr6(j,i)+
344 & wturn6*fact(5)*gcorr6_turn(j,i)+
345 & wsccor*fact(2)*gsccorc(j,i)
346 & +wliptran*gliptranc(j,i)
347 & +welec*gshieldc(j,i)
348 & +welec*gshieldc_loc(j,i)
349 & +wcorr*gshieldc_ec(j,i)
350 & +wcorr*gshieldc_loc_ec(j,i)
351 & +wturn3*gshieldc_t3(j,i)
352 & +wturn3*gshieldc_loc_t3(j,i)
353 & +wturn4*gshieldc_t4(j,i)
354 & +wturn4*gshieldc_loc_t4(j,i)
355 & +wel_loc*gshieldc_ll(j,i)
356 & +wel_loc*gshieldc_loc_ll(j,i)+
357 & wdfa_dist*gdfad(j,i)+
358 & wdfa_tor*gdfat(j,i)+
359 & wdfa_nei*gdfan(j,i)+
360 & wdfa_beta*gdfab(j,i)
361 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
362 & +fact(1)*wscp*gradx_scp(j,i)+
364 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
365 & wsccor*fact(2)*gsccorx(j,i)
366 & +wliptran*gliptranx(j,i)
367 & +welec*gshieldx(j,i)
368 & +wcorr*gshieldx_ec(j,i)
369 & +wturn3*gshieldx_t3(j,i)
370 & +wturn4*gshieldx_t4(j,i)
371 & +wel_loc*gshieldx_ll(j,i)
379 if (shield_mode.eq.0) then
380 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
381 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
383 & wcorr*fact(3)*gradcorr(j,i)+
384 & wel_loc*fact(2)*gel_loc(j,i)+
385 & wturn3*fact(2)*gcorr3_turn(j,i)+
386 & wturn4*fact(3)*gcorr4_turn(j,i)+
387 & wcorr5*fact(4)*gradcorr5(j,i)+
388 & wcorr6*fact(5)*gradcorr6(j,i)+
389 & wturn6*fact(5)*gcorr6_turn(j,i)+
390 & wsccor*fact(2)*gsccorc(j,i)
391 & +wliptran*gliptranc(j,i)+
392 & wdfa_dist*gdfad(j,i)+
393 & wdfa_tor*gdfat(j,i)+
394 & wdfa_nei*gdfan(j,i)+
395 & wdfa_beta*gdfab(j,i)
396 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
398 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
399 & wsccor*fact(1)*gsccorx(j,i)
400 & +wliptran*gliptranx(j,i)
402 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
403 & fact(1)*wscp*gvdwc_scp(j,i)+
404 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
406 & wcorr*fact(3)*gradcorr(j,i)+
407 & wel_loc*fact(2)*gel_loc(j,i)+
408 & wturn3*fact(2)*gcorr3_turn(j,i)+
409 & wturn4*fact(3)*gcorr4_turn(j,i)+
410 & wcorr5*fact(4)*gradcorr5(j,i)+
411 & wcorr6*fact(5)*gradcorr6(j,i)+
412 & wturn6*fact(5)*gcorr6_turn(j,i)+
413 & wsccor*fact(2)*gsccorc(j,i)
414 & +wliptran*gliptranc(j,i)
415 & +welec*gshieldc(j,i)
416 & +welec*gshieldc_loc(j,i)
417 & +wcorr*gshieldc_ec(j,i)
418 & +wcorr*gshieldc_loc_ec(j,i)
419 & +wturn3*gshieldc_t3(j,i)
420 & +wturn3*gshieldc_loc_t3(j,i)
421 & +wturn4*gshieldc_t4(j,i)
422 & +wturn4*gshieldc_loc_t4(j,i)
423 & +wel_loc*gshieldc_ll(j,i)
424 & +wel_loc*gshieldc_loc_ll(j,i)+
425 & wdfa_dist*gdfad(j,i)+
426 & wdfa_tor*gdfat(j,i)+
427 & wdfa_nei*gdfan(j,i)+
428 & wdfa_beta*gdfab(j,i)
429 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
430 & fact(1)*wscp*gradx_scp(j,i)+
432 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
433 & wsccor*fact(1)*gsccorx(j,i)
434 & +wliptran*gliptranx(j,i)
435 & +welec*gshieldx(j,i)
436 & +wcorr*gshieldx_ec(j,i)
437 & +wturn3*gshieldx_t3(j,i)
438 & +wturn4*gshieldx_t4(j,i)
439 & +wel_loc*gshieldx_ll(j,i)
447 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
448 & +wcorr5*fact(4)*g_corr5_loc(i)
449 & +wcorr6*fact(5)*g_corr6_loc(i)
450 & +wturn4*fact(3)*gel_loc_turn4(i)
451 & +wturn3*fact(2)*gel_loc_turn3(i)
452 & +wturn6*fact(5)*gel_loc_turn6(i)
453 & +wel_loc*fact(2)*gel_loc_loc(i)
454 c & +wsccor*fact(1)*gsccor_loc(i)
455 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
458 if (dyn_ss) call dyn_set_nss
461 C------------------------------------------------------------------------
462 subroutine enerprint(energia,fact)
463 implicit real*8 (a-h,o-z)
465 include 'COMMON.IOUNITS'
466 include 'COMMON.FFIELD'
467 include 'COMMON.SBRIDGE'
468 include 'COMMON.CONTROL'
469 double precision energia(0:max_ene),fact(6)
471 evdw=energia(1)+fact(6)*energia(21)
473 evdw2=energia(2)+energia(17)
485 eello_turn3=energia(8)
486 eello_turn4=energia(9)
487 eello_turn6=energia(10)
494 edihcnstr=energia(20)
496 ethetacnstr=energia(24)
499 ehomology_constr=energia(27)
501 edfadis = energia(28)
502 edfator = energia(29)
503 edfanei = energia(30)
504 edfabet = energia(31)
506 write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
507 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
508 & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3),
509 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),eel_loc,
510 & wel_loc*fact(2),eello_turn3,wturn3*fact(2),
511 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
512 & esccor,wsccor*fact(1),edihcnstr,
513 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
514 & etube,wtube,esaxs,wsaxs,ehomology_constr,
515 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
518 10 format (/'Virtual-chain energies:'//
519 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
520 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
521 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
522 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
523 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
524 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
525 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
526 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
527 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
528 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
529 & ' (SS bridges & dist. cnstr.)'/
530 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
531 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
532 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
533 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
534 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
535 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
536 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
537 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
538 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
539 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
540 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
541 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
542 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
543 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
544 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
545 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
546 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
547 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
548 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
549 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
550 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
551 & 'ETOT= ',1pE16.6,' (total)')
554 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
555 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
556 & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3),
557 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
558 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
559 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
560 & esccor,wsccor*fact(1),edihcnstr,
561 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
562 & etube,wtube,esaxs,wsaxs,ehomology_constr,
563 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
566 10 format (/'Virtual-chain energies:'//
567 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
568 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
569 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
570 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
571 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
572 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
573 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
574 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
575 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
576 & ' (SS bridges & dist. restr.)'/
577 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
578 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
579 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
580 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
581 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
582 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
583 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
584 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
585 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
586 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
587 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
588 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
589 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
590 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
591 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
592 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
593 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
594 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
595 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
596 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
597 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
598 & 'ETOT= ',1pE16.6,' (total)')
602 C-----------------------------------------------------------------------
603 subroutine elj(evdw,evdw_t)
605 C This subroutine calculates the interaction energy of nonbonded side chains
606 C assuming the LJ potential of interaction.
608 implicit real*8 (a-h,o-z)
610 include "DIMENSIONS.COMPAR"
611 parameter (accur=1.0d-10)
614 include 'COMMON.LOCAL'
615 include 'COMMON.CHAIN'
616 include 'COMMON.DERIV'
617 include 'COMMON.INTERACT'
618 include 'COMMON.TORSION'
619 include 'COMMON.SBRIDGE'
620 include 'COMMON.NAMES'
621 include 'COMMON.IOUNITS'
622 include 'COMMON.CONTACTS'
626 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
630 c eneps_temp(j,i)=0.0d0
639 if (itypi.eq.ntyp1) cycle
640 itypi1=iabs(itype(i+1))
647 C Calculate SC interaction energy.
650 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
651 cd & 'iend=',iend(i,iint)
652 do j=istart(i,iint),iend(i,iint)
654 if (itypj.eq.ntyp1) cycle
658 C Change 12/1/95 to calculate four-body interactions
659 rij=xj*xj+yj*yj+zj*zj
661 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
662 eps0ij=eps(itypi,itypj)
667 ij=icant(itypi,itypj)
669 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
670 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
673 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
674 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
675 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
676 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
677 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
678 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
679 if (bb.gt.0.0d0) then
686 C Calculate the components of the gradient in DC and X
688 fac=-rrij*(e1+evdwij)
693 gvdwx(k,i)=gvdwx(k,i)-gg(k)
694 gvdwx(k,j)=gvdwx(k,j)+gg(k)
698 gvdwc(l,k)=gvdwc(l,k)+gg(l)
703 C 12/1/95, revised on 5/20/97
705 C Calculate the contact function. The ith column of the array JCONT will
706 C contain the numbers of atoms that make contacts with the atom I (of numbers
707 C greater than I). The arrays FACONT and GACONT will contain the values of
708 C the contact function and its derivative.
710 C Uncomment next line, if the correlation interactions include EVDW explicitly.
711 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
712 C Uncomment next line, if the correlation interactions are contact function only
713 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
715 sigij=sigma(itypi,itypj)
716 r0ij=rs0(itypi,itypj)
718 C Check whether the SC's are not too far to make a contact.
721 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
722 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
724 if (fcont.gt.0.0D0) then
725 C If the SC-SC distance if close to sigma, apply spline.
726 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
727 cAdam & fcont1,fprimcont1)
728 cAdam fcont1=1.0d0-fcont1
729 cAdam if (fcont1.gt.0.0d0) then
730 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
731 cAdam fcont=fcont*fcont1
733 C Uncomment following 4 lines to have the geometric average of the epsilon0's
734 cga eps0ij=1.0d0/dsqrt(eps0ij)
736 cga gg(k)=gg(k)*eps0ij
738 cga eps0ij=-evdwij*eps0ij
739 C Uncomment for AL's type of SC correlation interactions.
741 num_conti=num_conti+1
743 facont(num_conti,i)=fcont*eps0ij
744 fprimcont=eps0ij*fprimcont/rij
746 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
747 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
748 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
749 C Uncomment following 3 lines for Skolnick's type of SC correlation.
750 gacont(1,num_conti,i)=-fprimcont*xj
751 gacont(2,num_conti,i)=-fprimcont*yj
752 gacont(3,num_conti,i)=-fprimcont*zj
753 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
754 cd write (iout,'(2i3,3f10.5)')
755 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
761 num_cont(i)=num_conti
766 gvdwc(j,i)=expon*gvdwc(j,i)
767 gvdwx(j,i)=expon*gvdwx(j,i)
771 C******************************************************************************
775 C To save time, the factor of EXPON has been extracted from ALL components
776 C of GVDWC and GRADX. Remember to multiply them by this factor before further
779 C******************************************************************************
782 C-----------------------------------------------------------------------------
783 subroutine eljk(evdw,evdw_t)
785 C This subroutine calculates the interaction energy of nonbonded side chains
786 C assuming the LJK potential of interaction.
788 implicit real*8 (a-h,o-z)
790 include "DIMENSIONS.COMPAR"
793 include 'COMMON.LOCAL'
794 include 'COMMON.CHAIN'
795 include 'COMMON.DERIV'
796 include 'COMMON.INTERACT'
797 include 'COMMON.IOUNITS'
798 include 'COMMON.NAMES'
803 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
806 c eneps_temp(j,i)=0.0d0
813 if (itypi.eq.ntyp1) cycle
814 itypi1=iabs(itype(i+1))
819 C Calculate SC interaction energy.
822 do j=istart(i,iint),iend(i,iint)
824 if (itypj.eq.ntyp1) cycle
828 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
830 e_augm=augm(itypi,itypj)*fac_augm
833 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
834 fac=r_shift_inv**expon
838 ij=icant(itypi,itypj)
839 c eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
840 c & /dabs(eps(itypi,itypj))
841 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
842 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
843 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
844 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
845 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
846 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
847 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
848 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
849 if (bb.gt.0.0d0) then
856 C Calculate the components of the gradient in DC and X
858 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
863 gvdwx(k,i)=gvdwx(k,i)-gg(k)
864 gvdwx(k,j)=gvdwx(k,j)+gg(k)
868 gvdwc(l,k)=gvdwc(l,k)+gg(l)
878 gvdwc(j,i)=expon*gvdwc(j,i)
879 gvdwx(j,i)=expon*gvdwx(j,i)
885 C-----------------------------------------------------------------------------
886 subroutine ebp(evdw,evdw_t)
888 C This subroutine calculates the interaction energy of nonbonded side chains
889 C assuming the Berne-Pechukas potential of interaction.
891 implicit real*8 (a-h,o-z)
893 include "DIMENSIONS.COMPAR"
896 include 'COMMON.LOCAL'
897 include 'COMMON.CHAIN'
898 include 'COMMON.DERIV'
899 include 'COMMON.NAMES'
900 include 'COMMON.INTERACT'
901 include 'COMMON.IOUNITS'
902 include 'COMMON.CALC'
904 c double precision rrsave(maxdim)
910 c eneps_temp(j,i)=0.0d0
915 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
916 c if (icall.eq.0) then
924 if (itypi.eq.ntyp1) cycle
925 itypi1=iabs(itype(i+1))
929 dxi=dc_norm(1,nres+i)
930 dyi=dc_norm(2,nres+i)
931 dzi=dc_norm(3,nres+i)
932 dsci_inv=vbld_inv(i+nres)
934 C Calculate SC interaction energy.
937 do j=istart(i,iint),iend(i,iint)
940 if (itypj.eq.ntyp1) cycle
941 dscj_inv=vbld_inv(j+nres)
942 chi1=chi(itypi,itypj)
943 chi2=chi(itypj,itypi)
950 alf12=0.5D0*(alf1+alf2)
951 C For diagnostics only!!!
964 dxj=dc_norm(1,nres+j)
965 dyj=dc_norm(2,nres+j)
966 dzj=dc_norm(3,nres+j)
967 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
968 cd if (icall.eq.0) then
974 C Calculate the angle-dependent terms of energy & contributions to derivatives.
976 C Calculate whole angle-dependent part of epsilon and contributions
978 fac=(rrij*sigsq)**expon2
981 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
982 eps2der=evdwij*eps3rt
983 eps3der=evdwij*eps2rt
984 evdwij=evdwij*eps2rt*eps3rt
985 ij=icant(itypi,itypj)
986 aux=eps1*eps2rt**2*eps3rt**2
987 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
988 c & /dabs(eps(itypi,itypj))
989 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
990 if (bb.gt.0.0d0) then
997 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
999 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1000 & restyp(itypi),i,restyp(itypj),j,
1001 & epsi,sigm,chi1,chi2,chip1,chip2,
1002 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1003 & om1,om2,om12,1.0D0/dsqrt(rrij),
1006 C Calculate gradient components.
1007 e1=e1*eps1*eps2rt**2*eps3rt**2
1008 fac=-expon*(e1+evdwij)
1011 C Calculate radial part of the gradient
1015 C Calculate the angular part of the gradient and sum add the contributions
1016 C to the appropriate components of the Cartesian gradient.
1025 C-----------------------------------------------------------------------------
1026 subroutine egb(evdw,evdw_t)
1028 C This subroutine calculates the interaction energy of nonbonded side chains
1029 C assuming the Gay-Berne potential of interaction.
1031 implicit real*8 (a-h,o-z)
1032 include 'DIMENSIONS'
1033 include "DIMENSIONS.COMPAR"
1034 include 'COMMON.GEO'
1035 include 'COMMON.VAR'
1036 include 'COMMON.LOCAL'
1037 include 'COMMON.CHAIN'
1038 include 'COMMON.DERIV'
1039 include 'COMMON.NAMES'
1040 include 'COMMON.INTERACT'
1041 include 'COMMON.IOUNITS'
1042 include 'COMMON.CALC'
1043 include 'COMMON.SBRIDGE'
1046 integer icant,xshift,yshift,zshift
1050 c eneps_temp(j,i)=0.0d0
1053 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1057 c if (icall.gt.0) lprn=.true.
1059 do i=iatsc_s,iatsc_e
1060 itypi=iabs(itype(i))
1061 if (itypi.eq.ntyp1) cycle
1062 itypi1=iabs(itype(i+1))
1066 C returning the ith atom to box
1068 if (xi.lt.0) xi=xi+boxxsize
1070 if (yi.lt.0) yi=yi+boxysize
1072 if (zi.lt.0) zi=zi+boxzsize
1073 if ((zi.gt.bordlipbot)
1074 &.and.(zi.lt.bordliptop)) then
1075 C the energy transfer exist
1076 if (zi.lt.buflipbot) then
1077 C what fraction I am in
1079 & ((zi-bordlipbot)/lipbufthick)
1080 C lipbufthick is thickenes of lipid buffore
1081 sslipi=sscalelip(fracinbuf)
1082 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1083 elseif (zi.gt.bufliptop) then
1084 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1085 sslipi=sscalelip(fracinbuf)
1086 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1096 dxi=dc_norm(1,nres+i)
1097 dyi=dc_norm(2,nres+i)
1098 dzi=dc_norm(3,nres+i)
1099 dsci_inv=vbld_inv(i+nres)
1101 C Calculate SC interaction energy.
1103 do iint=1,nint_gr(i)
1104 do j=istart(i,iint),iend(i,iint)
1105 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1106 call dyn_ssbond_ene(i,j,evdwij)
1108 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1109 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1110 C triple bond artifac removal
1111 do k=j+1,iend(i,iint)
1112 C search over all next residues
1113 if (dyn_ss_mask(k)) then
1114 C check if they are cysteins
1115 C write(iout,*) 'k=',k
1116 call triple_ssbond_ene(i,j,k,evdwij)
1117 C call the energy function that removes the artifical triple disulfide
1118 C bond the soubroutine is located in ssMD.F
1120 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1121 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1122 endif!dyn_ss_mask(k)
1126 itypj=iabs(itype(j))
1127 if (itypj.eq.ntyp1) cycle
1128 dscj_inv=vbld_inv(j+nres)
1129 sig0ij=sigma(itypi,itypj)
1130 chi1=chi(itypi,itypj)
1131 chi2=chi(itypj,itypi)
1138 alf12=0.5D0*(alf1+alf2)
1139 C For diagnostics only!!!
1152 C returning jth atom to box
1154 if (xj.lt.0) xj=xj+boxxsize
1156 if (yj.lt.0) yj=yj+boxysize
1158 if (zj.lt.0) zj=zj+boxzsize
1159 if ((zj.gt.bordlipbot)
1160 &.and.(zj.lt.bordliptop)) then
1161 C the energy transfer exist
1162 if (zj.lt.buflipbot) then
1163 C what fraction I am in
1165 & ((zj-bordlipbot)/lipbufthick)
1166 C lipbufthick is thickenes of lipid buffore
1167 sslipj=sscalelip(fracinbuf)
1168 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1169 elseif (zj.gt.bufliptop) then
1170 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1171 sslipj=sscalelip(fracinbuf)
1172 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1181 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1182 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1183 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1184 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1185 C if (aa.ne.aa_aq(itypi,itypj)) then
1187 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1188 C & bb_aq(itypi,itypj)-bb,
1192 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1193 C checking the distance
1194 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1199 C finding the closest
1203 xj=xj_safe+xshift*boxxsize
1204 yj=yj_safe+yshift*boxysize
1205 zj=zj_safe+zshift*boxzsize
1206 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1207 if(dist_temp.lt.dist_init) then
1217 if (subchap.eq.1) then
1227 dxj=dc_norm(1,nres+j)
1228 dyj=dc_norm(2,nres+j)
1229 dzj=dc_norm(3,nres+j)
1230 c write (iout,*) i,j,xj,yj,zj
1231 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1233 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1234 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1235 if (sss.le.0.0) cycle
1236 C Calculate angle-dependent terms of energy and contributions to their
1241 sig=sig0ij*dsqrt(sigsq)
1242 rij_shift=1.0D0/rij-sig+sig0ij
1243 C I hate to put IF's in the loops, but here don't have another choice!!!!
1244 if (rij_shift.le.0.0D0) then
1249 c---------------------------------------------------------------
1250 rij_shift=1.0D0/rij_shift
1251 fac=rij_shift**expon
1254 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1255 eps2der=evdwij*eps3rt
1256 eps3der=evdwij*eps2rt
1257 evdwij=evdwij*eps2rt*eps3rt
1259 evdw=evdw+evdwij*sss
1261 evdw_t=evdw_t+evdwij*sss
1263 ij=icant(itypi,itypj)
1264 aux=eps1*eps2rt**2*eps3rt**2
1265 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1266 c & /dabs(eps(itypi,itypj))
1267 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1268 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1269 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1270 c & aux*e2/eps(itypi,itypj)
1272 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1276 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1277 & restyp(itypi),i,restyp(itypj),j,
1278 & epsi,sigm,chi1,chi2,chip1,chip2,
1279 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1280 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1282 write (iout,*) "partial sum", evdw, evdw_t
1287 C Calculate gradient components.
1288 e1=e1*eps1*eps2rt**2*eps3rt**2
1289 fac=-expon*(e1+evdwij)*rij_shift
1292 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1293 C Calculate the radial part of the gradient
1297 C Calculate angular part of the gradient.
1300 C write(iout,*) "partial sum", evdw, evdw_t
1307 C-----------------------------------------------------------------------------
1308 subroutine egbv(evdw,evdw_t)
1310 C This subroutine calculates the interaction energy of nonbonded side chains
1311 C assuming the Gay-Berne-Vorobjev potential of interaction.
1313 implicit real*8 (a-h,o-z)
1314 include 'DIMENSIONS'
1315 include "DIMENSIONS.COMPAR"
1316 include 'COMMON.GEO'
1317 include 'COMMON.VAR'
1318 include 'COMMON.LOCAL'
1319 include 'COMMON.CHAIN'
1320 include 'COMMON.DERIV'
1321 include 'COMMON.NAMES'
1322 include 'COMMON.INTERACT'
1323 include 'COMMON.IOUNITS'
1324 include 'COMMON.CALC'
1325 common /srutu/ icall
1331 c eneps_temp(j,i)=0.0d0
1336 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1339 c if (icall.gt.0) lprn=.true.
1341 do i=iatsc_s,iatsc_e
1342 itypi=iabs(itype(i))
1343 if (itypi.eq.ntyp1) cycle
1344 itypi1=iabs(itype(i+1))
1348 dxi=dc_norm(1,nres+i)
1349 dyi=dc_norm(2,nres+i)
1350 dzi=dc_norm(3,nres+i)
1351 dsci_inv=vbld_inv(i+nres)
1353 C Calculate SC interaction energy.
1355 do iint=1,nint_gr(i)
1356 do j=istart(i,iint),iend(i,iint)
1358 itypj=iabs(itype(j))
1359 if (itypj.eq.ntyp1) cycle
1360 dscj_inv=vbld_inv(j+nres)
1361 sig0ij=sigma(itypi,itypj)
1362 r0ij=r0(itypi,itypj)
1363 chi1=chi(itypi,itypj)
1364 chi2=chi(itypj,itypi)
1371 alf12=0.5D0*(alf1+alf2)
1372 C For diagnostics only!!!
1385 dxj=dc_norm(1,nres+j)
1386 dyj=dc_norm(2,nres+j)
1387 dzj=dc_norm(3,nres+j)
1388 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1390 C Calculate angle-dependent terms of energy and contributions to their
1394 sig=sig0ij*dsqrt(sigsq)
1395 rij_shift=1.0D0/rij-sig+r0ij
1396 C I hate to put IF's in the loops, but here don't have another choice!!!!
1397 if (rij_shift.le.0.0D0) then
1402 c---------------------------------------------------------------
1403 rij_shift=1.0D0/rij_shift
1404 fac=rij_shift**expon
1407 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1408 eps2der=evdwij*eps3rt
1409 eps3der=evdwij*eps2rt
1410 fac_augm=rrij**expon
1411 e_augm=augm(itypi,itypj)*fac_augm
1412 evdwij=evdwij*eps2rt*eps3rt
1413 if (bb.gt.0.0d0) then
1414 evdw=evdw+evdwij+e_augm
1416 evdw_t=evdw_t+evdwij+e_augm
1418 ij=icant(itypi,itypj)
1419 aux=eps1*eps2rt**2*eps3rt**2
1420 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1421 c & /dabs(eps(itypi,itypj))
1422 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1423 c eneps_temp(ij)=eneps_temp(ij)
1424 c & +(evdwij+e_augm)/eps(itypi,itypj)
1426 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1427 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1428 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1429 c & restyp(itypi),i,restyp(itypj),j,
1430 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1431 c & chi1,chi2,chip1,chip2,
1432 c & eps1,eps2rt**2,eps3rt**2,
1433 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1437 C Calculate gradient components.
1438 e1=e1*eps1*eps2rt**2*eps3rt**2
1439 fac=-expon*(e1+evdwij)*rij_shift
1441 fac=rij*fac-2*expon*rrij*e_augm
1442 C Calculate the radial part of the gradient
1446 C Calculate angular part of the gradient.
1454 C-----------------------------------------------------------------------------
1455 subroutine sc_angular
1456 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1457 C om12. Called by ebp, egb, and egbv.
1459 include 'COMMON.CALC'
1463 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1464 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1465 om12=dxi*dxj+dyi*dyj+dzi*dzj
1467 C Calculate eps1(om12) and its derivative in om12
1468 faceps1=1.0D0-om12*chiom12
1469 faceps1_inv=1.0D0/faceps1
1470 eps1=dsqrt(faceps1_inv)
1471 C Following variable is eps1*deps1/dom12
1472 eps1_om12=faceps1_inv*chiom12
1473 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1478 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1479 sigsq=1.0D0-facsig*faceps1_inv
1480 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1481 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1482 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1483 C Calculate eps2 and its derivatives in om1, om2, and om12.
1486 chipom12=chip12*om12
1487 facp=1.0D0-om12*chipom12
1489 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1490 C Following variable is the square root of eps2
1491 eps2rt=1.0D0-facp1*facp_inv
1492 C Following three variables are the derivatives of the square root of eps
1493 C in om1, om2, and om12.
1494 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1495 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1496 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1497 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1498 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1499 C Calculate whole angle-dependent part of epsilon and contributions
1500 C to its derivatives
1503 C----------------------------------------------------------------------------
1505 implicit real*8 (a-h,o-z)
1506 include 'DIMENSIONS'
1507 include 'COMMON.CHAIN'
1508 include 'COMMON.DERIV'
1509 include 'COMMON.CALC'
1510 double precision dcosom1(3),dcosom2(3)
1511 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1512 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1513 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1514 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1516 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1517 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1520 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1523 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1524 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1525 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1526 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1527 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1528 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1531 C Calculate the components of the gradient in DC and X
1535 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1540 c------------------------------------------------------------------------------
1541 subroutine vec_and_deriv
1542 implicit real*8 (a-h,o-z)
1543 include 'DIMENSIONS'
1544 include 'COMMON.IOUNITS'
1545 include 'COMMON.GEO'
1546 include 'COMMON.VAR'
1547 include 'COMMON.LOCAL'
1548 include 'COMMON.CHAIN'
1549 include 'COMMON.VECTORS'
1550 include 'COMMON.DERIV'
1551 include 'COMMON.INTERACT'
1552 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1553 C Compute the local reference systems. For reference system (i), the
1554 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1555 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1557 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1558 if (i.eq.nres-1) then
1559 C Case of the last full residue
1560 C Compute the Z-axis
1561 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1562 costh=dcos(pi-theta(nres))
1563 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1564 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1570 C Compute the derivatives of uz
1572 uzder(2,1,1)=-dc_norm(3,i-1)
1573 uzder(3,1,1)= dc_norm(2,i-1)
1574 uzder(1,2,1)= dc_norm(3,i-1)
1576 uzder(3,2,1)=-dc_norm(1,i-1)
1577 uzder(1,3,1)=-dc_norm(2,i-1)
1578 uzder(2,3,1)= dc_norm(1,i-1)
1581 uzder(2,1,2)= dc_norm(3,i)
1582 uzder(3,1,2)=-dc_norm(2,i)
1583 uzder(1,2,2)=-dc_norm(3,i)
1585 uzder(3,2,2)= dc_norm(1,i)
1586 uzder(1,3,2)= dc_norm(2,i)
1587 uzder(2,3,2)=-dc_norm(1,i)
1590 C Compute the Y-axis
1593 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1596 C Compute the derivatives of uy
1599 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1600 & -dc_norm(k,i)*dc_norm(j,i-1)
1601 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1603 uyder(j,j,1)=uyder(j,j,1)-costh
1604 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1609 uygrad(l,k,j,i)=uyder(l,k,j)
1610 uzgrad(l,k,j,i)=uzder(l,k,j)
1614 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1615 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1616 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1617 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1621 C Compute the Z-axis
1622 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1623 costh=dcos(pi-theta(i+2))
1624 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1629 C Compute the derivatives of uz
1631 uzder(2,1,1)=-dc_norm(3,i+1)
1632 uzder(3,1,1)= dc_norm(2,i+1)
1633 uzder(1,2,1)= dc_norm(3,i+1)
1635 uzder(3,2,1)=-dc_norm(1,i+1)
1636 uzder(1,3,1)=-dc_norm(2,i+1)
1637 uzder(2,3,1)= dc_norm(1,i+1)
1640 uzder(2,1,2)= dc_norm(3,i)
1641 uzder(3,1,2)=-dc_norm(2,i)
1642 uzder(1,2,2)=-dc_norm(3,i)
1644 uzder(3,2,2)= dc_norm(1,i)
1645 uzder(1,3,2)= dc_norm(2,i)
1646 uzder(2,3,2)=-dc_norm(1,i)
1649 C Compute the Y-axis
1652 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1655 C Compute the derivatives of uy
1658 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1659 & -dc_norm(k,i)*dc_norm(j,i+1)
1660 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1662 uyder(j,j,1)=uyder(j,j,1)-costh
1663 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1668 uygrad(l,k,j,i)=uyder(l,k,j)
1669 uzgrad(l,k,j,i)=uzder(l,k,j)
1673 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1674 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1675 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1676 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1682 vbld_inv_temp(1)=vbld_inv(i+1)
1683 if (i.lt.nres-1) then
1684 vbld_inv_temp(2)=vbld_inv(i+2)
1686 vbld_inv_temp(2)=vbld_inv(i)
1691 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1692 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1700 C--------------------------------------------------------------------------
1701 subroutine set_matrices
1702 implicit real*8 (a-h,o-z)
1703 include 'DIMENSIONS'
1707 integer status(MPI_STATUS_SIZE)
1709 include 'COMMON.IOUNITS'
1710 include 'COMMON.GEO'
1711 include 'COMMON.VAR'
1712 include 'COMMON.LOCAL'
1713 include 'COMMON.CHAIN'
1714 include 'COMMON.DERIV'
1715 include 'COMMON.INTERACT'
1716 include 'COMMON.CONTACTS'
1717 include 'COMMON.TORSION'
1718 include 'COMMON.VECTORS'
1719 include 'COMMON.FFIELD'
1720 double precision auxvec(2),auxmat(2,2)
1722 C Compute the virtual-bond-torsional-angle dependent quantities needed
1723 C to calculate the el-loc multibody terms of various order.
1725 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1727 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1728 iti = itype2loc(itype(i-2))
1732 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1733 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1734 iti1 = itype2loc(itype(i-1))
1739 cost1=dcos(theta(i-1))
1740 sint1=dsin(theta(i-1))
1742 sint1cub=sint1sq*sint1
1743 sint1cost1=2*sint1*cost1
1745 write (iout,*) "bnew1",i,iti
1746 write (iout,*) (bnew1(k,1,iti),k=1,3)
1747 write (iout,*) (bnew1(k,2,iti),k=1,3)
1748 write (iout,*) "bnew2",i,iti
1749 write (iout,*) (bnew2(k,1,iti),k=1,3)
1750 write (iout,*) (bnew2(k,2,iti),k=1,3)
1753 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1755 gtb1(k,i-2)=cost1*b1k-sint1sq*
1756 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1757 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1759 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1760 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1763 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1764 cc(1,k,i-2)=sint1sq*aux
1765 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1766 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1767 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1768 dd(1,k,i-2)=sint1sq*aux
1769 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1770 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1772 cc(2,1,i-2)=cc(1,2,i-2)
1773 cc(2,2,i-2)=-cc(1,1,i-2)
1774 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1775 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1776 dd(2,1,i-2)=dd(1,2,i-2)
1777 dd(2,2,i-2)=-dd(1,1,i-2)
1778 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1779 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1782 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1783 EE(l,k,i-2)=sint1sq*aux
1785 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1788 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1789 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1790 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1791 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1793 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1794 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1795 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1797 c b1tilde(1,i-2)=b1(1,i-2)
1798 c b1tilde(2,i-2)=-b1(2,i-2)
1799 c b2tilde(1,i-2)=b2(1,i-2)
1800 c b2tilde(2,i-2)=-b2(2,i-2)
1802 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1803 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1804 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1805 write (iout,*) 'theta=', theta(i-1)
1808 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1809 c iti = itype2loc(itype(i-2))
1813 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1814 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1815 c iti1 = itype2loc(itype(i-1))
1825 CC(k,l,i-2)=ccold(k,l,iti)
1826 DD(k,l,i-2)=ddold(k,l,iti)
1827 EE(k,l,i-2)=eeold(k,l,iti)
1831 b1tilde(1,i-2)= b1(1,i-2)
1832 b1tilde(2,i-2)=-b1(2,i-2)
1833 b2tilde(1,i-2)= b2(1,i-2)
1834 b2tilde(2,i-2)=-b2(2,i-2)
1836 Ctilde(1,1,i-2)= CC(1,1,i-2)
1837 Ctilde(1,2,i-2)= CC(1,2,i-2)
1838 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1839 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1841 Dtilde(1,1,i-2)= DD(1,1,i-2)
1842 Dtilde(1,2,i-2)= DD(1,2,i-2)
1843 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1844 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1845 c write(iout,*) "i",i," iti",iti
1846 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1847 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1850 if (i .lt. nres+1) then
1887 if (i .gt. 3 .and. i .lt. nres+1) then
1888 obrot_der(1,i-2)=-sin1
1889 obrot_der(2,i-2)= cos1
1890 Ugder(1,1,i-2)= sin1
1891 Ugder(1,2,i-2)=-cos1
1892 Ugder(2,1,i-2)=-cos1
1893 Ugder(2,2,i-2)=-sin1
1896 obrot2_der(1,i-2)=-dwasin2
1897 obrot2_der(2,i-2)= dwacos2
1898 Ug2der(1,1,i-2)= dwasin2
1899 Ug2der(1,2,i-2)=-dwacos2
1900 Ug2der(2,1,i-2)=-dwacos2
1901 Ug2der(2,2,i-2)=-dwasin2
1903 obrot_der(1,i-2)=0.0d0
1904 obrot_der(2,i-2)=0.0d0
1905 Ugder(1,1,i-2)=0.0d0
1906 Ugder(1,2,i-2)=0.0d0
1907 Ugder(2,1,i-2)=0.0d0
1908 Ugder(2,2,i-2)=0.0d0
1909 obrot2_der(1,i-2)=0.0d0
1910 obrot2_der(2,i-2)=0.0d0
1911 Ug2der(1,1,i-2)=0.0d0
1912 Ug2der(1,2,i-2)=0.0d0
1913 Ug2der(2,1,i-2)=0.0d0
1914 Ug2der(2,2,i-2)=0.0d0
1916 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1917 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1918 iti = itype2loc(itype(i-2))
1922 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1923 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1924 iti1 = itype2loc(itype(i-1))
1928 cd write (iout,*) '*******i',i,' iti1',iti
1929 cd write (iout,*) 'b1',b1(:,iti)
1930 cd write (iout,*) 'b2',b2(:,iti)
1931 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1932 c if (i .gt. iatel_s+2) then
1933 if (i .gt. nnt+2) then
1934 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1936 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1937 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1939 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1940 c & EE(1,2,iti),EE(2,2,i)
1941 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1942 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1943 c write(iout,*) "Macierz EUG",
1944 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
1946 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
1948 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
1949 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
1950 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1951 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
1952 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
1963 DtUg2(l,k,i-2)=0.0d0
1967 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
1968 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
1970 muder(k,i-2)=Ub2der(k,i-2)
1972 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1973 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1974 if (itype(i-1).le.ntyp) then
1975 iti1 = itype2loc(itype(i-1))
1983 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
1986 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
1987 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
1988 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
1989 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
1990 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
1991 & ((ee(l,k,i-2),l=1,2),k=1,2)
1993 cd write (iout,*) 'mu1',mu1(:,i-2)
1994 cd write (iout,*) 'mu2',mu2(:,i-2)
1995 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
1998 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1999 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2000 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2001 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2002 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2004 C Vectors and matrices dependent on a single virtual-bond dihedral.
2005 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2006 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2007 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2008 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2009 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2011 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2012 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2013 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2014 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2018 C Matrices dependent on two consecutive virtual-bond dihedrals.
2019 C The order of matrices is from left to right.
2020 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2023 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2025 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2026 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2028 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2029 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2031 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2032 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2033 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2039 C--------------------------------------------------------------------------
2040 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2042 C This subroutine calculates the average interaction energy and its gradient
2043 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2044 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2045 C The potential depends both on the distance of peptide-group centers and on
2046 C the orientation of the CA-CA virtual bonds.
2048 implicit real*8 (a-h,o-z)
2052 include 'DIMENSIONS'
2053 include 'COMMON.CONTROL'
2054 include 'COMMON.IOUNITS'
2055 include 'COMMON.GEO'
2056 include 'COMMON.VAR'
2057 include 'COMMON.LOCAL'
2058 include 'COMMON.CHAIN'
2059 include 'COMMON.DERIV'
2060 include 'COMMON.INTERACT'
2061 include 'COMMON.CONTACTS'
2062 include 'COMMON.TORSION'
2063 include 'COMMON.VECTORS'
2064 include 'COMMON.FFIELD'
2065 include 'COMMON.TIME1'
2066 include 'COMMON.SPLITELE'
2067 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2068 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2069 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2070 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2071 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2072 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2074 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2076 double precision scal_el /1.0d0/
2078 double precision scal_el /0.5d0/
2081 C 13-go grudnia roku pamietnego...
2082 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2083 & 0.0d0,1.0d0,0.0d0,
2084 & 0.0d0,0.0d0,1.0d0/
2085 cd write(iout,*) 'In EELEC'
2087 cd write(iout,*) 'Type',i
2088 cd write(iout,*) 'B1',B1(:,i)
2089 cd write(iout,*) 'B2',B2(:,i)
2090 cd write(iout,*) 'CC',CC(:,:,i)
2091 cd write(iout,*) 'DD',DD(:,:,i)
2092 cd write(iout,*) 'EE',EE(:,:,i)
2094 cd call check_vecgrad
2096 if (icheckgrad.eq.1) then
2098 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2100 dc_norm(k,i)=dc(k,i)*fac
2102 c write (iout,*) 'i',i,' fac',fac
2105 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2106 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2107 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2108 c call vec_and_deriv
2114 time_mat=time_mat+MPI_Wtime()-time01
2118 cd write (iout,*) 'i=',i
2120 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2123 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2124 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2137 cd print '(a)','Enter EELEC'
2138 c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2141 gel_loc_loc(i)=0.0d0
2146 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2148 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2150 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2151 do i=iturn3_start,iturn3_end
2153 C write(iout,*) "tu jest i",i
2154 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2155 C changes suggested by Ana to avoid out of bounds
2156 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2157 c & .or.((i+4).gt.nres)
2158 c & .or.((i-1).le.0)
2159 C end of changes by Ana
2160 C dobra zmiana wycofana
2161 & .or. itype(i+2).eq.ntyp1
2162 & .or. itype(i+3).eq.ntyp1) cycle
2163 C Adam: Instructions below will switch off existing interactions
2165 c if(itype(i-1).eq.ntyp1)cycle
2167 c if(i.LT.nres-3)then
2168 c if (itype(i+4).eq.ntyp1) cycle
2173 dx_normi=dc_norm(1,i)
2174 dy_normi=dc_norm(2,i)
2175 dz_normi=dc_norm(3,i)
2176 xmedi=c(1,i)+0.5d0*dxi
2177 ymedi=c(2,i)+0.5d0*dyi
2178 zmedi=c(3,i)+0.5d0*dzi
2179 xmedi=mod(xmedi,boxxsize)
2180 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2181 ymedi=mod(ymedi,boxysize)
2182 if (ymedi.lt.0) ymedi=ymedi+boxysize
2183 zmedi=mod(zmedi,boxzsize)
2184 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2186 call eelecij(i,i+2,ees,evdw1,eel_loc)
2187 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2188 num_cont_hb(i)=num_conti
2190 do i=iturn4_start,iturn4_end
2192 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2193 C changes suggested by Ana to avoid out of bounds
2194 c & .or.((i+5).gt.nres)
2195 c & .or.((i-1).le.0)
2196 C end of changes suggested by Ana
2197 & .or. itype(i+3).eq.ntyp1
2198 & .or. itype(i+4).eq.ntyp1
2199 c & .or. itype(i+5).eq.ntyp1
2200 c & .or. itype(i).eq.ntyp1
2201 c & .or. itype(i-1).eq.ntyp1
2206 dx_normi=dc_norm(1,i)
2207 dy_normi=dc_norm(2,i)
2208 dz_normi=dc_norm(3,i)
2209 xmedi=c(1,i)+0.5d0*dxi
2210 ymedi=c(2,i)+0.5d0*dyi
2211 zmedi=c(3,i)+0.5d0*dzi
2212 C Return atom into box, boxxsize is size of box in x dimension
2214 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2215 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2216 C Condition for being inside the proper box
2217 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2218 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2222 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2223 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2224 C Condition for being inside the proper box
2225 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2226 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2230 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2231 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2232 C Condition for being inside the proper box
2233 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2234 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2237 xmedi=mod(xmedi,boxxsize)
2238 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2239 ymedi=mod(ymedi,boxysize)
2240 if (ymedi.lt.0) ymedi=ymedi+boxysize
2241 zmedi=mod(zmedi,boxzsize)
2242 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2244 num_conti=num_cont_hb(i)
2245 c write(iout,*) "JESTEM W PETLI"
2246 call eelecij(i,i+3,ees,evdw1,eel_loc)
2247 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2248 & call eturn4(i,eello_turn4)
2249 num_cont_hb(i)=num_conti
2251 C Loop over all neighbouring boxes
2256 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2259 do i=iatel_s,iatel_e
2262 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2263 C changes suggested by Ana to avoid out of bounds
2264 c & .or.((i+2).gt.nres)
2265 c & .or.((i-1).le.0)
2266 C end of changes by Ana
2267 c & .or. itype(i+2).eq.ntyp1
2268 c & .or. itype(i-1).eq.ntyp1
2273 dx_normi=dc_norm(1,i)
2274 dy_normi=dc_norm(2,i)
2275 dz_normi=dc_norm(3,i)
2276 xmedi=c(1,i)+0.5d0*dxi
2277 ymedi=c(2,i)+0.5d0*dyi
2278 zmedi=c(3,i)+0.5d0*dzi
2279 xmedi=mod(xmedi,boxxsize)
2280 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2281 ymedi=mod(ymedi,boxysize)
2282 if (ymedi.lt.0) ymedi=ymedi+boxysize
2283 zmedi=mod(zmedi,boxzsize)
2284 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2285 C xmedi=xmedi+xshift*boxxsize
2286 C ymedi=ymedi+yshift*boxysize
2287 C zmedi=zmedi+zshift*boxzsize
2289 C Return tom into box, boxxsize is size of box in x dimension
2291 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2292 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2293 C Condition for being inside the proper box
2294 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2295 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2299 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2300 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2301 C Condition for being inside the proper box
2302 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2303 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2307 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2308 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2309 cC Condition for being inside the proper box
2310 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2311 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2315 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2316 num_conti=num_cont_hb(i)
2318 do j=ielstart(i),ielend(i)
2320 C write (iout,*) i,j
2322 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2323 C changes suggested by Ana to avoid out of bounds
2324 c & .or.((j+2).gt.nres)
2325 c & .or.((j-1).le.0)
2326 C end of changes by Ana
2327 c & .or.itype(j+2).eq.ntyp1
2328 c & .or.itype(j-1).eq.ntyp1
2330 call eelecij(i,j,ees,evdw1,eel_loc)
2332 num_cont_hb(i)=num_conti
2338 c write (iout,*) "Number of loop steps in EELEC:",ind
2340 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2341 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2343 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2344 ccc eel_loc=eel_loc+eello_turn3
2345 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2348 C-------------------------------------------------------------------------------
2349 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2350 implicit real*8 (a-h,o-z)
2351 include 'DIMENSIONS'
2355 include 'COMMON.CONTROL'
2356 include 'COMMON.IOUNITS'
2357 include 'COMMON.GEO'
2358 include 'COMMON.VAR'
2359 include 'COMMON.LOCAL'
2360 include 'COMMON.CHAIN'
2361 include 'COMMON.DERIV'
2362 include 'COMMON.INTERACT'
2363 include 'COMMON.CONTACTS'
2364 include 'COMMON.TORSION'
2365 include 'COMMON.VECTORS'
2366 include 'COMMON.FFIELD'
2367 include 'COMMON.TIME1'
2368 include 'COMMON.SPLITELE'
2369 include 'COMMON.SHIELD'
2370 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2371 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2372 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2373 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2374 & gmuij2(4),gmuji2(4)
2375 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2376 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2378 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2380 double precision scal_el /1.0d0/
2382 double precision scal_el /0.5d0/
2385 C 13-go grudnia roku pamietnego...
2386 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2387 & 0.0d0,1.0d0,0.0d0,
2388 & 0.0d0,0.0d0,1.0d0/
2389 integer xshift,yshift,zshift
2390 c time00=MPI_Wtime()
2391 cd write (iout,*) "eelecij",i,j
2395 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2396 aaa=app(iteli,itelj)
2397 bbb=bpp(iteli,itelj)
2398 ael6i=ael6(iteli,itelj)
2399 ael3i=ael3(iteli,itelj)
2403 dx_normj=dc_norm(1,j)
2404 dy_normj=dc_norm(2,j)
2405 dz_normj=dc_norm(3,j)
2406 C xj=c(1,j)+0.5D0*dxj-xmedi
2407 C yj=c(2,j)+0.5D0*dyj-ymedi
2408 C zj=c(3,j)+0.5D0*dzj-zmedi
2413 if (xj.lt.0) xj=xj+boxxsize
2415 if (yj.lt.0) yj=yj+boxysize
2417 if (zj.lt.0) zj=zj+boxzsize
2418 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2419 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2427 xj=xj_safe+xshift*boxxsize
2428 yj=yj_safe+yshift*boxysize
2429 zj=zj_safe+zshift*boxzsize
2430 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2431 if(dist_temp.lt.dist_init) then
2441 if (isubchap.eq.1) then
2450 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2452 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2453 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2454 C Condition for being inside the proper box
2455 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2456 c & (xj.lt.((-0.5d0)*boxxsize))) then
2460 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2461 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2462 C Condition for being inside the proper box
2463 c if ((yj.gt.((0.5d0)*boxysize)).or.
2464 c & (yj.lt.((-0.5d0)*boxysize))) then
2468 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2469 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2470 C Condition for being inside the proper box
2471 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2472 c & (zj.lt.((-0.5d0)*boxzsize))) then
2475 C endif !endPBC condintion
2479 rij=xj*xj+yj*yj+zj*zj
2481 sss=sscale(sqrt(rij))
2482 sssgrad=sscagrad(sqrt(rij))
2483 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2484 c & " rlamb",rlamb," sss",sss
2485 c if (sss.gt.0.0d0) then
2491 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2492 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2493 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2494 fac=cosa-3.0D0*cosb*cosg
2496 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2497 if (j.eq.i+2) ev1=scal_el*ev1
2502 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2506 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2507 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2508 if (shield_mode.gt.0) then
2511 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2512 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2521 evdw1=evdw1+evdwij*sss
2522 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2523 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2524 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2525 cd & xmedi,ymedi,zmedi,xj,yj,zj
2527 if (energy_dec) then
2528 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2530 &,iteli,itelj,aaa,evdw1,sss
2531 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2532 &fac_shield(i),fac_shield(j)
2536 C Calculate contributions to the Cartesian gradient.
2539 facvdw=-6*rrmij*(ev1+evdwij)*sss
2540 facel=-3*rrmij*(el1+eesij)
2547 * Radial derivatives. First process both termini of the fragment (i,j)
2553 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2554 & (shield_mode.gt.0)) then
2556 do ilist=1,ishield_list(i)
2557 iresshield=shield_list(ilist,i)
2559 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2561 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2563 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2564 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2565 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2566 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2567 C if (iresshield.gt.i) then
2568 C do ishi=i+1,iresshield-1
2569 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2570 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2574 C do ishi=iresshield,i
2575 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2576 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2582 do ilist=1,ishield_list(j)
2583 iresshield=shield_list(ilist,j)
2585 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2587 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2589 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2590 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2592 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2593 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2594 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2595 C if (iresshield.gt.j) then
2596 C do ishi=j+1,iresshield-1
2597 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2598 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2602 C do ishi=iresshield,j
2603 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2604 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2611 gshieldc(k,i)=gshieldc(k,i)+
2612 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2613 gshieldc(k,j)=gshieldc(k,j)+
2614 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2615 gshieldc(k,i-1)=gshieldc(k,i-1)+
2616 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2617 gshieldc(k,j-1)=gshieldc(k,j-1)+
2618 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2623 c ghalf=0.5D0*ggg(k)
2624 c gelc(k,i)=gelc(k,i)+ghalf
2625 c gelc(k,j)=gelc(k,j)+ghalf
2627 c 9/28/08 AL Gradient compotents will be summed only at the end
2628 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2630 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2631 C & +grad_shield(k,j)*eesij/fac_shield(j)
2632 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2633 C & +grad_shield(k,i)*eesij/fac_shield(i)
2634 C gelc_long(k,i-1)=gelc_long(k,i-1)
2635 C & +grad_shield(k,i)*eesij/fac_shield(i)
2636 C gelc_long(k,j-1)=gelc_long(k,j-1)
2637 C & +grad_shield(k,j)*eesij/fac_shield(j)
2639 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2642 * Loop over residues i+1 thru j-1.
2646 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2649 if (sss.gt.0.0) then
2650 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2651 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2652 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2659 c ghalf=0.5D0*ggg(k)
2660 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2661 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2663 c 9/28/08 AL Gradient compotents will be summed only at the end
2665 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2666 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2669 * Loop over residues i+1 thru j-1.
2673 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2679 facvdw=(ev1+evdwij)*sss
2682 fac=-3*rrmij*(facvdw+facvdw+facel)
2687 * Radial derivatives. First process both termini of the fragment (i,j)
2691 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2693 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2695 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2697 c ghalf=0.5D0*ggg(k)
2698 c gelc(k,i)=gelc(k,i)+ghalf
2699 c gelc(k,j)=gelc(k,j)+ghalf
2701 c 9/28/08 AL Gradient compotents will be summed only at the end
2703 gelc_long(k,j)=gelc(k,j)+ggg(k)
2704 gelc_long(k,i)=gelc(k,i)-ggg(k)
2707 * Loop over residues i+1 thru j-1.
2711 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2714 c 9/28/08 AL Gradient compotents will be summed only at the end
2715 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2716 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2717 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2719 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2720 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2728 ecosa=2.0D0*fac3*fac1+fac4
2731 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2732 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2734 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2735 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2737 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2738 cd & (dcosg(k),k=1,3)
2740 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2741 & fac_shield(i)**2*fac_shield(j)**2
2744 c ghalf=0.5D0*ggg(k)
2745 c gelc(k,i)=gelc(k,i)+ghalf
2746 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2747 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2748 c gelc(k,j)=gelc(k,j)+ghalf
2749 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2750 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2754 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2757 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2760 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2761 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2762 & *fac_shield(i)**2*fac_shield(j)**2
2764 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2765 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2766 & *fac_shield(i)**2*fac_shield(j)**2
2767 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2768 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2770 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2775 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2776 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2777 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2779 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2780 C energy of a peptide unit is assumed in the form of a second-order
2781 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2782 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2783 C are computed for EVERY pair of non-contiguous peptide groups.
2786 if (j.lt.nres-1) then
2798 muij(kkk)=mu(k,i)*mu(l,j)
2799 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2802 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2803 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2804 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2805 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2806 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2807 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2813 write (iout,*) 'EELEC: i',i,' j',j
2814 write (iout,*) 'j',j,' j1',j1,' j2',j2
2815 write(iout,*) 'muij',muij
2816 write (iout,*) "uy",uy(:,i)
2817 write (iout,*) "uz",uz(:,j)
2818 write (iout,*) "erij",erij
2820 ury=scalar(uy(1,i),erij)
2821 urz=scalar(uz(1,i),erij)
2822 vry=scalar(uy(1,j),erij)
2823 vrz=scalar(uz(1,j),erij)
2824 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2825 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2826 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2827 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2828 fac=dsqrt(-ael6i)*r3ij
2833 cd write (iout,'(4i5,4f10.5)')
2834 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2835 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2836 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2837 cd & uy(:,j),uz(:,j)
2838 cd write (iout,'(4f10.5)')
2839 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2840 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2841 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2842 cd write (iout,'(9f10.5/)')
2843 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2844 C Derivatives of the elements of A in virtual-bond vectors
2846 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2848 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2849 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2850 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2851 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2852 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2853 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2854 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2855 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2856 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2857 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2858 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2859 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2861 C Compute radial contributions to the gradient
2879 C Add the contributions coming from er
2882 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2883 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2884 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2885 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2888 C Derivatives in DC(i)
2889 cgrad ghalf1=0.5d0*agg(k,1)
2890 cgrad ghalf2=0.5d0*agg(k,2)
2891 cgrad ghalf3=0.5d0*agg(k,3)
2892 cgrad ghalf4=0.5d0*agg(k,4)
2893 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2894 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2895 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2896 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2897 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2898 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2899 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2900 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2901 C Derivatives in DC(i+1)
2902 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2903 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2904 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2905 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2906 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2907 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2908 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2909 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2910 C Derivatives in DC(j)
2911 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2912 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2913 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2914 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2915 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2916 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2917 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2918 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2919 C Derivatives in DC(j+1) or DC(nres-1)
2920 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2921 & -3.0d0*vryg(k,3)*ury)
2922 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2923 & -3.0d0*vrzg(k,3)*ury)
2924 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2925 & -3.0d0*vryg(k,3)*urz)
2926 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2927 & -3.0d0*vrzg(k,3)*urz)
2928 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2930 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2945 aggi(k,l)=-aggi(k,l)
2946 aggi1(k,l)=-aggi1(k,l)
2947 aggj(k,l)=-aggj(k,l)
2948 aggj1(k,l)=-aggj1(k,l)
2952 if (j.lt.nres-1) then
2958 aggi(k,l)=-aggi(k,l)
2959 aggi1(k,l)=-aggi1(k,l)
2960 aggj(k,l)=-aggj(k,l)
2961 aggj1(k,l)=-aggj1(k,l)
2972 aggi(k,l)=-aggi(k,l)
2973 aggi1(k,l)=-aggi1(k,l)
2974 aggj(k,l)=-aggj(k,l)
2975 aggj1(k,l)=-aggj1(k,l)
2980 IF (wel_loc.gt.0.0d0) THEN
2981 C Contribution to the local-electrostatic energy coming from the i-j pair
2982 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2985 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
2987 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
2988 & " wel_loc",wel_loc
2990 if (shield_mode.eq.0) then
2997 eel_loc_ij=eel_loc_ij
2998 & *fac_shield(i)*fac_shield(j)
2999 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3000 & 'eelloc',i,j,eel_loc_ij
3001 c if (eel_loc_ij.ne.0)
3002 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3003 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3005 eel_loc=eel_loc+eel_loc_ij
3006 C Now derivative over eel_loc
3008 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3009 & (shield_mode.gt.0)) then
3012 do ilist=1,ishield_list(i)
3013 iresshield=shield_list(ilist,i)
3015 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
3018 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3020 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
3021 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3025 do ilist=1,ishield_list(j)
3026 iresshield=shield_list(ilist,j)
3028 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
3031 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3033 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3034 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3041 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3042 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3043 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3044 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3045 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3046 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3047 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3048 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3053 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3054 c & ' eel_loc_ij',eel_loc_ij
3055 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3056 C Calculate patrial derivative for theta angle
3058 geel_loc_ij=(a22*gmuij1(1)
3062 & *fac_shield(i)*fac_shield(j)
3063 c write(iout,*) "derivative over thatai"
3064 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3066 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3067 & geel_loc_ij*wel_loc
3068 c write(iout,*) "derivative over thatai-1"
3069 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3076 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3077 & geel_loc_ij*wel_loc
3078 & *fac_shield(i)*fac_shield(j)
3080 c Derivative over j residue
3081 geel_loc_ji=a22*gmuji1(1)
3085 c write(iout,*) "derivative over thataj"
3086 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3089 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3090 & geel_loc_ji*wel_loc
3091 & *fac_shield(i)*fac_shield(j)
3098 c write(iout,*) "derivative over thataj-1"
3099 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3101 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3102 & geel_loc_ji*wel_loc
3103 & *fac_shield(i)*fac_shield(j)
3105 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3107 C Partial derivatives in virtual-bond dihedral angles gamma
3109 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3110 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3111 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3112 & *fac_shield(i)*fac_shield(j)
3114 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3115 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3116 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3117 & *fac_shield(i)*fac_shield(j)
3118 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3120 ggg(l)=(agg(l,1)*muij(1)+
3121 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3122 & *fac_shield(i)*fac_shield(j)
3123 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3124 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3125 cgrad ghalf=0.5d0*ggg(l)
3126 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3127 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3131 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3134 C Remaining derivatives of eello
3136 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3137 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3138 & *fac_shield(i)*fac_shield(j)
3140 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3141 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3142 & *fac_shield(i)*fac_shield(j)
3144 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3145 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3146 & *fac_shield(i)*fac_shield(j)
3148 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3149 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3150 & *fac_shield(i)*fac_shield(j)
3157 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3158 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3159 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3160 & .and. num_conti.le.maxconts) then
3161 c write (iout,*) i,j," entered corr"
3163 C Calculate the contact function. The ith column of the array JCONT will
3164 C contain the numbers of atoms that make contacts with the atom I (of numbers
3165 C greater than I). The arrays FACONT and GACONT will contain the values of
3166 C the contact function and its derivative.
3167 c r0ij=1.02D0*rpp(iteli,itelj)
3168 c r0ij=1.11D0*rpp(iteli,itelj)
3169 r0ij=2.20D0*rpp(iteli,itelj)
3170 c r0ij=1.55D0*rpp(iteli,itelj)
3171 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3172 if (fcont.gt.0.0D0) then
3173 num_conti=num_conti+1
3174 if (num_conti.gt.maxconts) then
3175 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3176 & ' will skip next contacts for this conf.'
3178 jcont_hb(num_conti,i)=j
3179 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3180 cd & " jcont_hb",jcont_hb(num_conti,i)
3181 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3182 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3183 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3185 d_cont(num_conti,i)=rij
3186 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3187 C --- Electrostatic-interaction matrix ---
3188 a_chuj(1,1,num_conti,i)=a22
3189 a_chuj(1,2,num_conti,i)=a23
3190 a_chuj(2,1,num_conti,i)=a32
3191 a_chuj(2,2,num_conti,i)=a33
3192 C --- Gradient of rij
3195 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3202 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3203 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3204 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3205 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3206 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3212 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3213 C Calculate contact energies
3215 wij=cosa-3.0D0*cosb*cosg
3218 c fac3=dsqrt(-ael6i)/r0ij**3
3219 fac3=dsqrt(-ael6i)*r3ij
3220 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3221 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3222 if (ees0tmp.gt.0) then
3223 ees0pij=dsqrt(ees0tmp)
3227 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3228 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3229 if (ees0tmp.gt.0) then
3230 ees0mij=dsqrt(ees0tmp)
3235 if (shield_mode.eq.0) then
3239 ees0plist(num_conti,i)=j
3240 C fac_shield(i)=0.4d0
3241 C fac_shield(j)=0.6d0
3243 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3244 & *fac_shield(i)*fac_shield(j)
3245 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3246 & *fac_shield(i)*fac_shield(j)
3247 C Diagnostics. Comment out or remove after debugging!
3248 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3249 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3250 c ees0m(num_conti,i)=0.0D0
3252 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3253 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3254 C Angular derivatives of the contact function
3256 ees0pij1=fac3/ees0pij
3257 ees0mij1=fac3/ees0mij
3258 fac3p=-3.0D0*fac3*rrmij
3259 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3260 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3262 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3263 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3264 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3265 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3266 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3267 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3268 ecosap=ecosa1+ecosa2
3269 ecosbp=ecosb1+ecosb2
3270 ecosgp=ecosg1+ecosg2
3271 ecosam=ecosa1-ecosa2
3272 ecosbm=ecosb1-ecosb2
3273 ecosgm=ecosg1-ecosg2
3282 facont_hb(num_conti,i)=fcont
3285 fprimcont=fprimcont/rij
3286 cd facont_hb(num_conti,i)=1.0D0
3287 C Following line is for diagnostics.
3290 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3291 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3294 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3295 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3297 gggp(1)=gggp(1)+ees0pijp*xj
3298 gggp(2)=gggp(2)+ees0pijp*yj
3299 gggp(3)=gggp(3)+ees0pijp*zj
3300 gggm(1)=gggm(1)+ees0mijp*xj
3301 gggm(2)=gggm(2)+ees0mijp*yj
3302 gggm(3)=gggm(3)+ees0mijp*zj
3303 C Derivatives due to the contact function
3304 gacont_hbr(1,num_conti,i)=fprimcont*xj
3305 gacont_hbr(2,num_conti,i)=fprimcont*yj
3306 gacont_hbr(3,num_conti,i)=fprimcont*zj
3309 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3310 c following the change of gradient-summation algorithm.
3312 cgrad ghalfp=0.5D0*gggp(k)
3313 cgrad ghalfm=0.5D0*gggm(k)
3314 gacontp_hb1(k,num_conti,i)=!ghalfp
3315 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3316 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3317 & *fac_shield(i)*fac_shield(j)
3319 gacontp_hb2(k,num_conti,i)=!ghalfp
3320 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3321 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3322 & *fac_shield(i)*fac_shield(j)
3324 gacontp_hb3(k,num_conti,i)=gggp(k)
3325 & *fac_shield(i)*fac_shield(j)
3327 gacontm_hb1(k,num_conti,i)=!ghalfm
3328 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3329 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3330 & *fac_shield(i)*fac_shield(j)
3332 gacontm_hb2(k,num_conti,i)=!ghalfm
3333 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3334 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3335 & *fac_shield(i)*fac_shield(j)
3337 gacontm_hb3(k,num_conti,i)=gggm(k)
3338 & *fac_shield(i)*fac_shield(j)
3341 C Diagnostics. Comment out or remove after debugging!
3343 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3344 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3345 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3346 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3347 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3348 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3354 endif ! num_conti.le.maxconts
3358 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3361 ghalf=0.5d0*agg(l,k)
3362 aggi(l,k)=aggi(l,k)+ghalf
3363 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3364 aggj(l,k)=aggj(l,k)+ghalf
3367 if (j.eq.nres-1 .and. i.lt.j-2) then
3370 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3376 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3379 C-----------------------------------------------------------------------------
3380 subroutine eturn3(i,eello_turn3)
3381 C Third- and fourth-order contributions from turns
3382 implicit real*8 (a-h,o-z)
3383 include 'DIMENSIONS'
3384 include 'COMMON.IOUNITS'
3385 include 'COMMON.GEO'
3386 include 'COMMON.VAR'
3387 include 'COMMON.LOCAL'
3388 include 'COMMON.CHAIN'
3389 include 'COMMON.DERIV'
3390 include 'COMMON.INTERACT'
3391 include 'COMMON.CONTACTS'
3392 include 'COMMON.TORSION'
3393 include 'COMMON.VECTORS'
3394 include 'COMMON.FFIELD'
3395 include 'COMMON.CONTROL'
3396 include 'COMMON.SHIELD'
3398 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3399 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3400 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3401 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3402 & auxgmat2(2,2),auxgmatt2(2,2)
3403 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3404 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3405 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3406 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3409 c write (iout,*) "eturn3",i,j,j1,j2
3414 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3416 C Third-order contributions
3423 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3424 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3425 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3426 c auxalary matices for theta gradient
3427 c auxalary matrix for i+1 and constant i+2
3428 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3429 c auxalary matrix for i+2 and constant i+1
3430 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3431 call transpose2(auxmat(1,1),auxmat1(1,1))
3432 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3433 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3434 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3435 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3436 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3437 if (shield_mode.eq.0) then
3444 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3445 & *fac_shield(i)*fac_shield(j)
3446 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3447 & *fac_shield(i)*fac_shield(j)
3448 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3452 C Derivatives in theta
3453 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3454 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3455 & *fac_shield(i)*fac_shield(j)
3456 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3457 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3458 & *fac_shield(i)*fac_shield(j)
3461 C Derivatives in shield mode
3462 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3463 & (shield_mode.gt.0)) then
3466 do ilist=1,ishield_list(i)
3467 iresshield=shield_list(ilist,i)
3469 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3471 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3473 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3474 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3478 do ilist=1,ishield_list(j)
3479 iresshield=shield_list(ilist,j)
3481 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3483 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3485 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3486 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3493 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3494 & grad_shield(k,i)*eello_t3/fac_shield(i)
3495 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3496 & grad_shield(k,j)*eello_t3/fac_shield(j)
3497 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3498 & grad_shield(k,i)*eello_t3/fac_shield(i)
3499 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3500 & grad_shield(k,j)*eello_t3/fac_shield(j)
3504 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3505 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3506 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3507 cd & ' eello_turn3_num',4*eello_turn3_num
3508 C Derivatives in gamma(i)
3509 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3510 call transpose2(auxmat2(1,1),auxmat3(1,1))
3511 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3512 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3513 & *fac_shield(i)*fac_shield(j)
3514 C Derivatives in gamma(i+1)
3515 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3516 call transpose2(auxmat2(1,1),auxmat3(1,1))
3517 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3518 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3519 & +0.5d0*(pizda(1,1)+pizda(2,2))
3520 & *fac_shield(i)*fac_shield(j)
3521 C Cartesian derivatives
3523 c ghalf1=0.5d0*agg(l,1)
3524 c ghalf2=0.5d0*agg(l,2)
3525 c ghalf3=0.5d0*agg(l,3)
3526 c ghalf4=0.5d0*agg(l,4)
3527 a_temp(1,1)=aggi(l,1)!+ghalf1
3528 a_temp(1,2)=aggi(l,2)!+ghalf2
3529 a_temp(2,1)=aggi(l,3)!+ghalf3
3530 a_temp(2,2)=aggi(l,4)!+ghalf4
3531 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3532 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3533 & +0.5d0*(pizda(1,1)+pizda(2,2))
3534 & *fac_shield(i)*fac_shield(j)
3536 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3537 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3538 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3539 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3540 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3541 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3542 & +0.5d0*(pizda(1,1)+pizda(2,2))
3543 & *fac_shield(i)*fac_shield(j)
3544 a_temp(1,1)=aggj(l,1)!+ghalf1
3545 a_temp(1,2)=aggj(l,2)!+ghalf2
3546 a_temp(2,1)=aggj(l,3)!+ghalf3
3547 a_temp(2,2)=aggj(l,4)!+ghalf4
3548 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3549 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3550 & +0.5d0*(pizda(1,1)+pizda(2,2))
3551 & *fac_shield(i)*fac_shield(j)
3552 a_temp(1,1)=aggj1(l,1)
3553 a_temp(1,2)=aggj1(l,2)
3554 a_temp(2,1)=aggj1(l,3)
3555 a_temp(2,2)=aggj1(l,4)
3556 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3557 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3558 & +0.5d0*(pizda(1,1)+pizda(2,2))
3559 & *fac_shield(i)*fac_shield(j)
3566 C-------------------------------------------------------------------------------
3567 subroutine eturn4(i,eello_turn4)
3568 C Third- and fourth-order contributions from turns
3569 implicit real*8 (a-h,o-z)
3570 include 'DIMENSIONS'
3571 include 'COMMON.IOUNITS'
3572 include 'COMMON.GEO'
3573 include 'COMMON.VAR'
3574 include 'COMMON.LOCAL'
3575 include 'COMMON.CHAIN'
3576 include 'COMMON.DERIV'
3577 include 'COMMON.INTERACT'
3578 include 'COMMON.CONTACTS'
3579 include 'COMMON.TORSION'
3580 include 'COMMON.VECTORS'
3581 include 'COMMON.FFIELD'
3582 include 'COMMON.CONTROL'
3583 include 'COMMON.SHIELD'
3585 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3586 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3587 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3588 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3589 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3590 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3591 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3592 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3593 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3594 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3595 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3598 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3600 C Fourth-order contributions
3608 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3609 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3610 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3611 c write(iout,*)"WCHODZE W PROGRAM"
3616 iti1=itype2loc(itype(i+1))
3617 iti2=itype2loc(itype(i+2))
3618 iti3=itype2loc(itype(i+3))
3619 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3620 call transpose2(EUg(1,1,i+1),e1t(1,1))
3621 call transpose2(Eug(1,1,i+2),e2t(1,1))
3622 call transpose2(Eug(1,1,i+3),e3t(1,1))
3623 C Ematrix derivative in theta
3624 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3625 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3626 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3627 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3628 c eta1 in derivative theta
3629 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3630 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3631 c auxgvec is derivative of Ub2 so i+3 theta
3632 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3633 c auxalary matrix of E i+1
3634 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3637 s1=scalar2(b1(1,i+2),auxvec(1))
3638 c derivative of theta i+2 with constant i+3
3639 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3640 c derivative of theta i+2 with constant i+2
3641 gs32=scalar2(b1(1,i+2),auxgvec(1))
3642 c derivative of E matix in theta of i+1
3643 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3645 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3646 c ea31 in derivative theta
3647 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3648 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3649 c auxilary matrix auxgvec of Ub2 with constant E matirx
3650 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3651 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3652 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3656 s2=scalar2(b1(1,i+1),auxvec(1))
3657 c derivative of theta i+1 with constant i+3
3658 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3659 c derivative of theta i+2 with constant i+1
3660 gs21=scalar2(b1(1,i+1),auxgvec(1))
3661 c derivative of theta i+3 with constant i+1
3662 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3663 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3665 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3666 c two derivatives over diffetent matrices
3667 c gtae3e2 is derivative over i+3
3668 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3669 c ae3gte2 is derivative over i+2
3670 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3671 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3672 c three possible derivative over theta E matices
3674 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3676 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3678 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3679 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3681 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3682 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3683 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3684 if (shield_mode.eq.0) then
3691 eello_turn4=eello_turn4-(s1+s2+s3)
3692 & *fac_shield(i)*fac_shield(j)
3693 eello_t4=-(s1+s2+s3)
3694 & *fac_shield(i)*fac_shield(j)
3695 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3696 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3697 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3698 C Now derivative over shield:
3699 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3700 & (shield_mode.gt.0)) then
3703 do ilist=1,ishield_list(i)
3704 iresshield=shield_list(ilist,i)
3706 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3708 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3710 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3711 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3715 do ilist=1,ishield_list(j)
3716 iresshield=shield_list(ilist,j)
3718 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3720 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3722 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3723 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3730 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3731 & grad_shield(k,i)*eello_t4/fac_shield(i)
3732 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3733 & grad_shield(k,j)*eello_t4/fac_shield(j)
3734 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3735 & grad_shield(k,i)*eello_t4/fac_shield(i)
3736 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3737 & grad_shield(k,j)*eello_t4/fac_shield(j)
3740 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3741 cd & ' eello_turn4_num',8*eello_turn4_num
3743 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3744 & -(gs13+gsE13+gsEE1)*wturn4
3745 & *fac_shield(i)*fac_shield(j)
3746 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3747 & -(gs23+gs21+gsEE2)*wturn4
3748 & *fac_shield(i)*fac_shield(j)
3750 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3751 & -(gs32+gsE31+gsEE3)*wturn4
3752 & *fac_shield(i)*fac_shield(j)
3754 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3757 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3758 & 'eturn4',i,j,-(s1+s2+s3)
3759 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3760 c & ' eello_turn4_num',8*eello_turn4_num
3761 C Derivatives in gamma(i)
3762 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3763 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3764 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3765 s1=scalar2(b1(1,i+2),auxvec(1))
3766 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3767 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3768 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3769 & *fac_shield(i)*fac_shield(j)
3770 C Derivatives in gamma(i+1)
3771 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3772 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3773 s2=scalar2(b1(1,i+1),auxvec(1))
3774 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3775 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3776 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3777 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3778 & *fac_shield(i)*fac_shield(j)
3779 C Derivatives in gamma(i+2)
3780 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3781 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3782 s1=scalar2(b1(1,i+2),auxvec(1))
3783 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3784 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3785 s2=scalar2(b1(1,i+1),auxvec(1))
3786 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3787 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3788 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3789 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3790 & *fac_shield(i)*fac_shield(j)
3792 C Cartesian derivatives
3793 C Derivatives of this turn contributions in DC(i+2)
3794 if (j.lt.nres-1) then
3796 a_temp(1,1)=agg(l,1)
3797 a_temp(1,2)=agg(l,2)
3798 a_temp(2,1)=agg(l,3)
3799 a_temp(2,2)=agg(l,4)
3800 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3801 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3802 s1=scalar2(b1(1,i+2),auxvec(1))
3803 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3804 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3805 s2=scalar2(b1(1,i+1),auxvec(1))
3806 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3807 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3808 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3810 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3811 & *fac_shield(i)*fac_shield(j)
3814 C Remaining derivatives of this turn contribution
3816 a_temp(1,1)=aggi(l,1)
3817 a_temp(1,2)=aggi(l,2)
3818 a_temp(2,1)=aggi(l,3)
3819 a_temp(2,2)=aggi(l,4)
3820 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3821 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3822 s1=scalar2(b1(1,i+2),auxvec(1))
3823 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3824 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3825 s2=scalar2(b1(1,i+1),auxvec(1))
3826 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3827 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3828 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3829 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3830 & *fac_shield(i)*fac_shield(j)
3831 a_temp(1,1)=aggi1(l,1)
3832 a_temp(1,2)=aggi1(l,2)
3833 a_temp(2,1)=aggi1(l,3)
3834 a_temp(2,2)=aggi1(l,4)
3835 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3836 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3837 s1=scalar2(b1(1,i+2),auxvec(1))
3838 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3839 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3840 s2=scalar2(b1(1,i+1),auxvec(1))
3841 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3842 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3843 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3844 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3845 & *fac_shield(i)*fac_shield(j)
3846 a_temp(1,1)=aggj(l,1)
3847 a_temp(1,2)=aggj(l,2)
3848 a_temp(2,1)=aggj(l,3)
3849 a_temp(2,2)=aggj(l,4)
3850 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3851 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3852 s1=scalar2(b1(1,i+2),auxvec(1))
3853 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3854 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3855 s2=scalar2(b1(1,i+1),auxvec(1))
3856 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3857 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3858 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3859 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3860 & *fac_shield(i)*fac_shield(j)
3861 a_temp(1,1)=aggj1(l,1)
3862 a_temp(1,2)=aggj1(l,2)
3863 a_temp(2,1)=aggj1(l,3)
3864 a_temp(2,2)=aggj1(l,4)
3865 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3866 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3867 s1=scalar2(b1(1,i+2),auxvec(1))
3868 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3869 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3870 s2=scalar2(b1(1,i+1),auxvec(1))
3871 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3872 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3873 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3874 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3875 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3876 & *fac_shield(i)*fac_shield(j)
3883 C-----------------------------------------------------------------------------
3884 subroutine vecpr(u,v,w)
3885 implicit real*8(a-h,o-z)
3886 dimension u(3),v(3),w(3)
3887 w(1)=u(2)*v(3)-u(3)*v(2)
3888 w(2)=-u(1)*v(3)+u(3)*v(1)
3889 w(3)=u(1)*v(2)-u(2)*v(1)
3892 C-----------------------------------------------------------------------------
3893 subroutine unormderiv(u,ugrad,unorm,ungrad)
3894 C This subroutine computes the derivatives of a normalized vector u, given
3895 C the derivatives computed without normalization conditions, ugrad. Returns
3898 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3899 double precision vec(3)
3900 double precision scalar
3902 c write (2,*) 'ugrad',ugrad
3905 vec(i)=scalar(ugrad(1,i),u(1))
3907 c write (2,*) 'vec',vec
3910 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3913 c write (2,*) 'ungrad',ungrad
3916 C-----------------------------------------------------------------------------
3917 subroutine escp(evdw2,evdw2_14)
3919 C This subroutine calculates the excluded-volume interaction energy between
3920 C peptide-group centers and side chains and its gradient in virtual-bond and
3921 C side-chain vectors.
3923 implicit real*8 (a-h,o-z)
3924 include 'DIMENSIONS'
3925 include 'COMMON.GEO'
3926 include 'COMMON.VAR'
3927 include 'COMMON.LOCAL'
3928 include 'COMMON.CHAIN'
3929 include 'COMMON.DERIV'
3930 include 'COMMON.INTERACT'
3931 include 'COMMON.FFIELD'
3932 include 'COMMON.IOUNITS'
3936 cd print '(a)','Enter ESCP'
3937 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3938 c & ' scal14',scal14
3939 do i=iatscp_s,iatscp_e
3940 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3942 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3943 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3944 if (iteli.eq.0) goto 1225
3945 xi=0.5D0*(c(1,i)+c(1,i+1))
3946 yi=0.5D0*(c(2,i)+c(2,i+1))
3947 zi=0.5D0*(c(3,i)+c(3,i+1))
3948 C Returning the ith atom to box
3950 if (xi.lt.0) xi=xi+boxxsize
3952 if (yi.lt.0) yi=yi+boxysize
3954 if (zi.lt.0) zi=zi+boxzsize
3955 do iint=1,nscp_gr(i)
3957 do j=iscpstart(i,iint),iscpend(i,iint)
3958 itypj=iabs(itype(j))
3959 if (itypj.eq.ntyp1) cycle
3960 C Uncomment following three lines for SC-p interactions
3964 C Uncomment following three lines for Ca-p interactions
3968 C returning the jth atom to box
3970 if (xj.lt.0) xj=xj+boxxsize
3972 if (yj.lt.0) yj=yj+boxysize
3974 if (zj.lt.0) zj=zj+boxzsize
3975 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3980 C Finding the closest jth atom
3984 xj=xj_safe+xshift*boxxsize
3985 yj=yj_safe+yshift*boxysize
3986 zj=zj_safe+zshift*boxzsize
3987 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3988 if(dist_temp.lt.dist_init) then
3998 if (subchap.eq.1) then
4007 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4008 C sss is scaling function for smoothing the cutoff gradient otherwise
4009 C the gradient would not be continuouse
4010 sss=sscale(1.0d0/(dsqrt(rrij)))
4011 if (sss.le.0.0d0) cycle
4012 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4014 e1=fac*fac*aad(itypj,iteli)
4015 e2=fac*bad(itypj,iteli)
4016 if (iabs(j-i) .le. 2) then
4019 evdw2_14=evdw2_14+(e1+e2)*sss
4022 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4023 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4024 c & bad(itypj,iteli)
4025 evdw2=evdw2+evdwij*sss
4028 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4030 fac=-(evdwij+e1)*rrij*sss
4031 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4036 cd write (iout,*) 'j<i'
4037 C Uncomment following three lines for SC-p interactions
4039 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4042 cd write (iout,*) 'j>i'
4045 C Uncomment following line for SC-p interactions
4046 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4050 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4054 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4055 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4058 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4068 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4069 gradx_scp(j,i)=expon*gradx_scp(j,i)
4072 C******************************************************************************
4076 C To save time the factor EXPON has been extracted from ALL components
4077 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4080 C******************************************************************************
4083 C--------------------------------------------------------------------------
4084 subroutine edis(ehpb)
4086 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4088 implicit real*8 (a-h,o-z)
4089 include 'DIMENSIONS'
4090 include 'COMMON.SBRIDGE'
4091 include 'COMMON.CHAIN'
4092 include 'COMMON.DERIV'
4093 include 'COMMON.VAR'
4094 include 'COMMON.INTERACT'
4095 include 'COMMON.CONTROL'
4096 include 'COMMON.IOUNITS'
4097 dimension ggg(3),ggg_peak(3,1000)
4100 c 8/21/18 AL: added explicit restraints on reference coords
4101 c write (iout,*) "restr_on_coord",restr_on_coord
4102 if (restr_on_coord) then
4106 if (itype(i).eq.ntyp1) cycle
4108 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4109 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4111 if (itype(i).ne.10) then
4113 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4114 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4117 if (energy_dec) write (iout,*)
4118 & "i",i," bfac",bfac(i)," ecoor",ecoor
4119 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4123 C write (iout,*) ,"link_end",link_end,constr_dist
4124 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4125 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4126 c & " constr_dist",constr_dist
4127 if (link_end.eq.0.and.link_end_peak.eq.0) return
4128 do i=link_start_peak,link_end_peak
4130 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4131 c & ipeak(1,i),ipeak(2,i)
4132 do ip=ipeak(1,i),ipeak(2,i)
4137 C iii and jjj point to the residues for which the distance is assigned.
4138 c if (ii.gt.nres) then
4145 if (ii.gt.nres) then
4150 if (jj.gt.nres) then
4155 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4156 aux=dexp(-scal_peak*aux)
4157 ehpb_peak=ehpb_peak+aux
4158 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4159 & forcon_peak(ip))*aux/dd
4161 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4163 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4164 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4165 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4167 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4168 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4169 do ip=ipeak(1,i),ipeak(2,i)
4172 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4176 C iii and jjj point to the residues for which the distance is assigned.
4177 c if (ii.gt.nres) then
4184 if (ii.gt.nres) then
4189 if (jj.gt.nres) then
4196 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4201 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4205 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4206 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4210 do i=link_start,link_end
4211 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4212 C CA-CA distance used in regularization of structure.
4215 C iii and jjj point to the residues for which the distance is assigned.
4216 c if (ii.gt.nres) then
4223 if (ii.gt.nres) then
4228 if (jj.gt.nres) then
4233 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4234 c & dhpb(i),dhpb1(i),forcon(i)
4235 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4236 C distance and angle dependent SS bond potential.
4237 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4238 C & iabs(itype(jjj)).eq.1) then
4239 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4240 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4241 if (.not.dyn_ss .and. i.le.nss) then
4242 C 15/02/13 CC dynamic SSbond - additional check
4243 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4244 & iabs(itype(jjj)).eq.1) then
4245 call ssbond_ene(iii,jjj,eij)
4248 cd write (iout,*) "eij",eij
4249 cd & ' waga=',waga,' fac=',fac
4250 ! else if (ii.gt.nres .and. jj.gt.nres) then
4252 C Calculate the distance between the two points and its difference from the
4255 if (irestr_type(i).eq.11) then
4256 ehpb=ehpb+fordepth(i)!**4.0d0
4257 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4258 fac=fordepth(i)!**4.0d0
4259 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4260 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4261 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4262 & ehpb,irestr_type(i)
4263 else if (irestr_type(i).eq.10) then
4264 c AL 6//19/2018 cross-link restraints
4265 xdis = 0.5d0*(dd/forcon(i))**2
4266 expdis = dexp(-xdis)
4267 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4268 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4269 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4270 c & " wboltzd",wboltzd
4271 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4272 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4273 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4274 & *expdis/(aux*forcon(i)**2)
4275 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4276 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4277 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4278 else if (irestr_type(i).eq.2) then
4279 c Quartic restraints
4280 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4281 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4282 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4283 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4284 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4286 c Quadratic restraints
4288 C Get the force constant corresponding to this distance.
4290 C Calculate the contribution to energy.
4291 ehpb=ehpb+0.5d0*waga*rdis*rdis
4292 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4293 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4294 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4296 C Evaluate gradient.
4300 c Calculate Cartesian gradient
4302 ggg(j)=fac*(c(j,jj)-c(j,ii))
4304 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4305 C If this is a SC-SC distance, we need to calculate the contributions to the
4306 C Cartesian gradient in the SC vectors (ghpbx).
4309 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4314 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4318 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4319 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4325 C--------------------------------------------------------------------------
4326 subroutine ssbond_ene(i,j,eij)
4328 C Calculate the distance and angle dependent SS-bond potential energy
4329 C using a free-energy function derived based on RHF/6-31G** ab initio
4330 C calculations of diethyl disulfide.
4332 C A. Liwo and U. Kozlowska, 11/24/03
4334 implicit real*8 (a-h,o-z)
4335 include 'DIMENSIONS'
4336 include 'COMMON.SBRIDGE'
4337 include 'COMMON.CHAIN'
4338 include 'COMMON.DERIV'
4339 include 'COMMON.LOCAL'
4340 include 'COMMON.INTERACT'
4341 include 'COMMON.VAR'
4342 include 'COMMON.IOUNITS'
4343 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4344 itypi=iabs(itype(i))
4348 dxi=dc_norm(1,nres+i)
4349 dyi=dc_norm(2,nres+i)
4350 dzi=dc_norm(3,nres+i)
4351 dsci_inv=dsc_inv(itypi)
4352 itypj=iabs(itype(j))
4353 dscj_inv=dsc_inv(itypj)
4357 dxj=dc_norm(1,nres+j)
4358 dyj=dc_norm(2,nres+j)
4359 dzj=dc_norm(3,nres+j)
4360 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4365 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4366 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4367 om12=dxi*dxj+dyi*dyj+dzi*dzj
4369 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4370 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4376 deltat12=om2-om1+2.0d0
4378 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4379 & +akct*deltad*deltat12
4380 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4381 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4382 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4383 c & " deltat12",deltat12," eij",eij
4384 ed=2*akcm*deltad+akct*deltat12
4386 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4387 eom1=-2*akth*deltat1-pom1-om2*pom2
4388 eom2= 2*akth*deltat2+pom1-om1*pom2
4391 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4394 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4395 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4396 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4397 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4400 C Calculate the components of the gradient in DC and X
4404 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4409 C--------------------------------------------------------------------------
4410 subroutine ebond(estr)
4412 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4414 implicit real*8 (a-h,o-z)
4415 include 'DIMENSIONS'
4416 include 'COMMON.LOCAL'
4417 include 'COMMON.GEO'
4418 include 'COMMON.INTERACT'
4419 include 'COMMON.DERIV'
4420 include 'COMMON.VAR'
4421 include 'COMMON.CHAIN'
4422 include 'COMMON.IOUNITS'
4423 include 'COMMON.NAMES'
4424 include 'COMMON.FFIELD'
4425 include 'COMMON.CONTROL'
4426 double precision u(3),ud(3)
4429 c write (iout,*) "distchainmax",distchainmax
4431 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4432 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4434 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4435 C & *dc(j,i-1)/vbld(i)
4437 C if (energy_dec) write(iout,*)
4438 C & "estr1",i,vbld(i),distchainmax,
4439 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4441 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4442 diff = vbld(i)-vbldpDUM
4443 C write(iout,*) i,diff
4445 diff = vbld(i)-vbldp0
4446 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4450 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4453 C write (iout,'(a7,i5,4f7.3)')
4454 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4456 estr=0.5d0*AKP*estr+estr1
4458 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4462 if (iti.ne.10 .and. iti.ne.ntyp1) then
4465 diff=vbld(i+nres)-vbldsc0(1,iti)
4466 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4467 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4468 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4470 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4474 diff=vbld(i+nres)-vbldsc0(j,iti)
4475 ud(j)=aksc(j,iti)*diff
4476 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4490 uprod2=uprod2*u(k)*u(k)
4494 usumsqder=usumsqder+ud(j)*uprod2
4496 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4497 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4498 estr=estr+uprod/usum
4500 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4508 C--------------------------------------------------------------------------
4509 subroutine ebend(etheta,ethetacnstr)
4511 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4512 C angles gamma and its derivatives in consecutive thetas and gammas.
4514 implicit real*8 (a-h,o-z)
4515 include 'DIMENSIONS'
4516 include 'COMMON.LOCAL'
4517 include 'COMMON.GEO'
4518 include 'COMMON.INTERACT'
4519 include 'COMMON.DERIV'
4520 include 'COMMON.VAR'
4521 include 'COMMON.CHAIN'
4522 include 'COMMON.IOUNITS'
4523 include 'COMMON.NAMES'
4524 include 'COMMON.FFIELD'
4525 include 'COMMON.TORCNSTR'
4526 common /calcthet/ term1,term2,termm,diffak,ratak,
4527 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4528 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4529 double precision y(2),z(2)
4531 c time11=dexp(-2*time)
4534 c write (iout,*) "nres",nres
4535 c write (*,'(a,i2)') 'EBEND ICG=',icg
4536 c write (iout,*) ithet_start,ithet_end
4537 do i=ithet_start,ithet_end
4538 C if (itype(i-1).eq.ntyp1) cycle
4540 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4541 & .or.itype(i).eq.ntyp1) cycle
4542 C Zero the energy function and its derivative at 0 or pi.
4543 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4545 ichir1=isign(1,itype(i-2))
4546 ichir2=isign(1,itype(i))
4547 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4548 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4549 if (itype(i-1).eq.10) then
4550 itype1=isign(10,itype(i-2))
4551 ichir11=isign(1,itype(i-2))
4552 ichir12=isign(1,itype(i-2))
4553 itype2=isign(10,itype(i))
4554 ichir21=isign(1,itype(i))
4555 ichir22=isign(1,itype(i))
4562 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4566 c call proc_proc(phii,icrc)
4567 if (icrc.eq.1) phii=150.0
4578 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4582 c call proc_proc(phii1,icrc)
4583 if (icrc.eq.1) phii1=150.0
4595 C Calculate the "mean" value of theta from the part of the distribution
4596 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4597 C In following comments this theta will be referred to as t_c.
4598 thet_pred_mean=0.0d0
4600 athetk=athet(k,it,ichir1,ichir2)
4601 bthetk=bthet(k,it,ichir1,ichir2)
4603 athetk=athet(k,itype1,ichir11,ichir12)
4604 bthetk=bthet(k,itype2,ichir21,ichir22)
4606 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4608 c write (iout,*) "thet_pred_mean",thet_pred_mean
4609 dthett=thet_pred_mean*ssd
4610 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4611 c write (iout,*) "thet_pred_mean",thet_pred_mean
4612 C Derivatives of the "mean" values in gamma1 and gamma2.
4613 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4614 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4615 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4616 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4618 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4619 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4620 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4621 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4623 if (theta(i).gt.pi-delta) then
4624 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4626 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4627 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4628 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4630 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4632 else if (theta(i).lt.delta) then
4633 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4634 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4635 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4637 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4638 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4641 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4644 etheta=etheta+ethetai
4645 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4646 c & 'ebend',i,ethetai,theta(i),itype(i)
4647 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4648 c & rad2deg*phii,rad2deg*phii1,ethetai
4649 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4650 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4651 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4655 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4656 do i=1,ntheta_constr
4657 itheta=itheta_constr(i)
4658 thetiii=theta(itheta)
4659 difi=pinorm(thetiii-theta_constr0(i))
4660 if (difi.gt.theta_drange(i)) then
4661 difi=difi-theta_drange(i)
4662 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4663 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4664 & +for_thet_constr(i)*difi**3
4665 else if (difi.lt.-drange(i)) then
4667 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4668 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4669 & +for_thet_constr(i)*difi**3
4673 C if (energy_dec) then
4674 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4675 C & i,itheta,rad2deg*thetiii,
4676 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4677 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4678 C & gloc(itheta+nphi-2,icg)
4681 C Ufff.... We've done all this!!!
4684 C---------------------------------------------------------------------------
4685 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4687 implicit real*8 (a-h,o-z)
4688 include 'DIMENSIONS'
4689 include 'COMMON.LOCAL'
4690 include 'COMMON.IOUNITS'
4691 common /calcthet/ term1,term2,termm,diffak,ratak,
4692 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4693 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4694 C Calculate the contributions to both Gaussian lobes.
4695 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4696 C The "polynomial part" of the "standard deviation" of this part of
4700 sig=sig*thet_pred_mean+polthet(j,it)
4702 C Derivative of the "interior part" of the "standard deviation of the"
4703 C gamma-dependent Gaussian lobe in t_c.
4704 sigtc=3*polthet(3,it)
4706 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4709 C Set the parameters of both Gaussian lobes of the distribution.
4710 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4711 fac=sig*sig+sigc0(it)
4714 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4715 sigsqtc=-4.0D0*sigcsq*sigtc
4716 c print *,i,sig,sigtc,sigsqtc
4717 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4718 sigtc=-sigtc/(fac*fac)
4719 C Following variable is sigma(t_c)**(-2)
4720 sigcsq=sigcsq*sigcsq
4722 sig0inv=1.0D0/sig0i**2
4723 delthec=thetai-thet_pred_mean
4724 delthe0=thetai-theta0i
4725 term1=-0.5D0*sigcsq*delthec*delthec
4726 term2=-0.5D0*sig0inv*delthe0*delthe0
4727 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4728 C NaNs in taking the logarithm. We extract the largest exponent which is added
4729 C to the energy (this being the log of the distribution) at the end of energy
4730 C term evaluation for this virtual-bond angle.
4731 if (term1.gt.term2) then
4733 term2=dexp(term2-termm)
4737 term1=dexp(term1-termm)
4740 C The ratio between the gamma-independent and gamma-dependent lobes of
4741 C the distribution is a Gaussian function of thet_pred_mean too.
4742 diffak=gthet(2,it)-thet_pred_mean
4743 ratak=diffak/gthet(3,it)**2
4744 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4745 C Let's differentiate it in thet_pred_mean NOW.
4747 C Now put together the distribution terms to make complete distribution.
4748 termexp=term1+ak*term2
4749 termpre=sigc+ak*sig0i
4750 C Contribution of the bending energy from this theta is just the -log of
4751 C the sum of the contributions from the two lobes and the pre-exponential
4752 C factor. Simple enough, isn't it?
4753 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4754 C NOW the derivatives!!!
4755 C 6/6/97 Take into account the deformation.
4756 E_theta=(delthec*sigcsq*term1
4757 & +ak*delthe0*sig0inv*term2)/termexp
4758 E_tc=((sigtc+aktc*sig0i)/termpre
4759 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4760 & aktc*term2)/termexp)
4763 c-----------------------------------------------------------------------------
4764 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4765 implicit real*8 (a-h,o-z)
4766 include 'DIMENSIONS'
4767 include 'COMMON.LOCAL'
4768 include 'COMMON.IOUNITS'
4769 common /calcthet/ term1,term2,termm,diffak,ratak,
4770 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4771 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4772 delthec=thetai-thet_pred_mean
4773 delthe0=thetai-theta0i
4774 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4775 t3 = thetai-thet_pred_mean
4779 t14 = t12+t6*sigsqtc
4781 t21 = thetai-theta0i
4787 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4788 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4789 & *(-t12*t9-ak*sig0inv*t27)
4793 C--------------------------------------------------------------------------
4794 subroutine ebend(etheta)
4796 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4797 C angles gamma and its derivatives in consecutive thetas and gammas.
4798 C ab initio-derived potentials from
4799 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4801 implicit real*8 (a-h,o-z)
4802 include 'DIMENSIONS'
4803 include 'COMMON.LOCAL'
4804 include 'COMMON.GEO'
4805 include 'COMMON.INTERACT'
4806 include 'COMMON.DERIV'
4807 include 'COMMON.VAR'
4808 include 'COMMON.CHAIN'
4809 include 'COMMON.IOUNITS'
4810 include 'COMMON.NAMES'
4811 include 'COMMON.FFIELD'
4812 include 'COMMON.CONTROL'
4813 include 'COMMON.TORCNSTR'
4814 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4815 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4816 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4817 & sinph1ph2(maxdouble,maxdouble)
4818 logical lprn /.false./, lprn1 /.false./
4820 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4821 do i=ithet_start,ithet_end
4823 C if (itype(i-1).eq.ntyp1) cycle
4825 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4826 & .or.itype(i).eq.ntyp1) cycle
4827 if (iabs(itype(i+1)).eq.20) iblock=2
4828 if (iabs(itype(i+1)).ne.20) iblock=1
4832 theti2=0.5d0*theta(i)
4833 ityp2=ithetyp((itype(i-1)))
4835 coskt(k)=dcos(k*theti2)
4836 sinkt(k)=dsin(k*theti2)
4846 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4849 if (phii.ne.phii) phii=150.0
4853 ityp1=ithetyp((itype(i-2)))
4855 cosph1(k)=dcos(k*phii)
4856 sinph1(k)=dsin(k*phii)
4862 ityp1=ithetyp((itype(i-2)))
4868 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4871 if (phii1.ne.phii1) phii1=150.0
4876 ityp3=ithetyp((itype(i)))
4878 cosph2(k)=dcos(k*phii1)
4879 sinph2(k)=dsin(k*phii1)
4884 ityp3=ithetyp((itype(i)))
4890 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4891 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4893 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4896 ccl=cosph1(l)*cosph2(k-l)
4897 ssl=sinph1(l)*sinph2(k-l)
4898 scl=sinph1(l)*cosph2(k-l)
4899 csl=cosph1(l)*sinph2(k-l)
4900 cosph1ph2(l,k)=ccl-ssl
4901 cosph1ph2(k,l)=ccl+ssl
4902 sinph1ph2(l,k)=scl+csl
4903 sinph1ph2(k,l)=scl-csl
4907 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4908 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4909 write (iout,*) "coskt and sinkt"
4911 write (iout,*) k,coskt(k),sinkt(k)
4915 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4916 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4919 & write (iout,*) "k",k,"
4920 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4921 & " ethetai",ethetai
4924 write (iout,*) "cosph and sinph"
4926 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4928 write (iout,*) "cosph1ph2 and sinph2ph2"
4931 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4932 & sinph1ph2(l,k),sinph1ph2(k,l)
4935 write(iout,*) "ethetai",ethetai
4939 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4940 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4941 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4942 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4943 ethetai=ethetai+sinkt(m)*aux
4944 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4945 dephii=dephii+k*sinkt(m)*(
4946 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4947 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4948 dephii1=dephii1+k*sinkt(m)*(
4949 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4950 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4952 & write (iout,*) "m",m," k",k," bbthet",
4953 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4954 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4955 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4956 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4960 & write(iout,*) "ethetai",ethetai
4964 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4965 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4966 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4967 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4968 ethetai=ethetai+sinkt(m)*aux
4969 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4970 dephii=dephii+l*sinkt(m)*(
4971 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4972 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4973 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4974 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4975 dephii1=dephii1+(k-l)*sinkt(m)*(
4976 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4977 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4978 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4979 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4981 write (iout,*) "m",m," k",k," l",l," ffthet",
4982 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4983 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4984 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4985 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4986 & " ethetai",ethetai
4987 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4988 & cosph1ph2(k,l)*sinkt(m),
4989 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4995 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4996 & i,theta(i)*rad2deg,phii*rad2deg,
4997 & phii1*rad2deg,ethetai
4998 etheta=etheta+ethetai
4999 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5000 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5001 c gloc(nphi+i-2,icg)=wang*dethetai
5002 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5008 c-----------------------------------------------------------------------------
5009 subroutine esc(escloc)
5010 C Calculate the local energy of a side chain and its derivatives in the
5011 C corresponding virtual-bond valence angles THETA and the spherical angles
5013 implicit real*8 (a-h,o-z)
5014 include 'DIMENSIONS'
5015 include 'COMMON.GEO'
5016 include 'COMMON.LOCAL'
5017 include 'COMMON.VAR'
5018 include 'COMMON.INTERACT'
5019 include 'COMMON.DERIV'
5020 include 'COMMON.CHAIN'
5021 include 'COMMON.IOUNITS'
5022 include 'COMMON.NAMES'
5023 include 'COMMON.FFIELD'
5024 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5025 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5026 common /sccalc/ time11,time12,time112,theti,it,nlobit
5029 C write (iout,*) 'ESC'
5030 do i=loc_start,loc_end
5032 if (it.eq.ntyp1) cycle
5033 if (it.eq.10) goto 1
5034 nlobit=nlob(iabs(it))
5035 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5036 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5037 theti=theta(i+1)-pipol
5041 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5043 if (x(2).gt.pi-delta) then
5047 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5049 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5050 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5052 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5053 & ddersc0(1),dersc(1))
5054 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5055 & ddersc0(3),dersc(3))
5057 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5059 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5060 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5061 & dersc0(2),esclocbi,dersc02)
5062 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5064 call splinthet(x(2),0.5d0*delta,ss,ssd)
5069 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5071 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5072 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5074 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5076 c write (iout,*) escloci
5077 else if (x(2).lt.delta) then
5081 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5083 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5084 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5086 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5087 & ddersc0(1),dersc(1))
5088 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5089 & ddersc0(3),dersc(3))
5091 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5093 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5094 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5095 & dersc0(2),esclocbi,dersc02)
5096 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5101 call splinthet(x(2),0.5d0*delta,ss,ssd)
5103 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5105 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5106 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5108 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5109 C write (iout,*) 'i=',i, escloci
5111 call enesc(x,escloci,dersc,ddummy,.false.)
5114 escloc=escloc+escloci
5115 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5116 write (iout,'(a6,i5,0pf7.3)')
5117 & 'escloc',i,escloci
5119 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5121 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5122 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5127 C---------------------------------------------------------------------------
5128 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5129 implicit real*8 (a-h,o-z)
5130 include 'DIMENSIONS'
5131 include 'COMMON.GEO'
5132 include 'COMMON.LOCAL'
5133 include 'COMMON.IOUNITS'
5134 common /sccalc/ time11,time12,time112,theti,it,nlobit
5135 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5136 double precision contr(maxlob,-1:1)
5138 c write (iout,*) 'it=',it,' nlobit=',nlobit
5142 if (mixed) ddersc(j)=0.0d0
5146 C Because of periodicity of the dependence of the SC energy in omega we have
5147 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5148 C To avoid underflows, first compute & store the exponents.
5156 z(k)=x(k)-censc(k,j,it)
5161 Axk=Axk+gaussc(l,k,j,it)*z(l)
5167 expfac=expfac+Ax(k,j,iii)*z(k)
5175 C As in the case of ebend, we want to avoid underflows in exponentiation and
5176 C subsequent NaNs and INFs in energy calculation.
5177 C Find the largest exponent
5181 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5185 cd print *,'it=',it,' emin=',emin
5187 C Compute the contribution to SC energy and derivatives
5191 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5192 cd print *,'j=',j,' expfac=',expfac
5193 escloc_i=escloc_i+expfac
5195 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5199 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5200 & +gaussc(k,2,j,it))*expfac
5207 dersc(1)=dersc(1)/cos(theti)**2
5208 ddersc(1)=ddersc(1)/cos(theti)**2
5211 escloci=-(dlog(escloc_i)-emin)
5213 dersc(j)=dersc(j)/escloc_i
5217 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5222 C------------------------------------------------------------------------------
5223 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5224 implicit real*8 (a-h,o-z)
5225 include 'DIMENSIONS'
5226 include 'COMMON.GEO'
5227 include 'COMMON.LOCAL'
5228 include 'COMMON.IOUNITS'
5229 common /sccalc/ time11,time12,time112,theti,it,nlobit
5230 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5231 double precision contr(maxlob)
5242 z(k)=x(k)-censc(k,j,it)
5248 Axk=Axk+gaussc(l,k,j,it)*z(l)
5254 expfac=expfac+Ax(k,j)*z(k)
5259 C As in the case of ebend, we want to avoid underflows in exponentiation and
5260 C subsequent NaNs and INFs in energy calculation.
5261 C Find the largest exponent
5264 if (emin.gt.contr(j)) emin=contr(j)
5268 C Compute the contribution to SC energy and derivatives
5272 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5273 escloc_i=escloc_i+expfac
5275 dersc(k)=dersc(k)+Ax(k,j)*expfac
5277 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5278 & +gaussc(1,2,j,it))*expfac
5282 dersc(1)=dersc(1)/cos(theti)**2
5283 dersc12=dersc12/cos(theti)**2
5284 escloci=-(dlog(escloc_i)-emin)
5286 dersc(j)=dersc(j)/escloc_i
5288 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5292 c----------------------------------------------------------------------------------
5293 subroutine esc(escloc)
5294 C Calculate the local energy of a side chain and its derivatives in the
5295 C corresponding virtual-bond valence angles THETA and the spherical angles
5296 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5297 C added by Urszula Kozlowska. 07/11/2007
5299 implicit real*8 (a-h,o-z)
5300 include 'DIMENSIONS'
5301 include 'COMMON.GEO'
5302 include 'COMMON.LOCAL'
5303 include 'COMMON.VAR'
5304 include 'COMMON.SCROT'
5305 include 'COMMON.INTERACT'
5306 include 'COMMON.DERIV'
5307 include 'COMMON.CHAIN'
5308 include 'COMMON.IOUNITS'
5309 include 'COMMON.NAMES'
5310 include 'COMMON.FFIELD'
5311 include 'COMMON.CONTROL'
5312 include 'COMMON.VECTORS'
5313 double precision x_prime(3),y_prime(3),z_prime(3)
5314 & , sumene,dsc_i,dp2_i,x(65),
5315 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5316 & de_dxx,de_dyy,de_dzz,de_dt
5317 double precision s1_t,s1_6_t,s2_t,s2_6_t
5319 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5320 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5321 & dt_dCi(3),dt_dCi1(3)
5322 common /sccalc/ time11,time12,time112,theti,it,nlobit
5325 do i=loc_start,loc_end
5326 if (itype(i).eq.ntyp1) cycle
5327 costtab(i+1) =dcos(theta(i+1))
5328 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5329 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5330 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5331 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5332 cosfac=dsqrt(cosfac2)
5333 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5334 sinfac=dsqrt(sinfac2)
5336 if (it.eq.10) goto 1
5338 C Compute the axes of tghe local cartesian coordinates system; store in
5339 c x_prime, y_prime and z_prime
5346 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5347 C & dc_norm(3,i+nres)
5349 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5350 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5353 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5356 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5357 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5358 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5359 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5360 c & " xy",scalar(x_prime(1),y_prime(1)),
5361 c & " xz",scalar(x_prime(1),z_prime(1)),
5362 c & " yy",scalar(y_prime(1),y_prime(1)),
5363 c & " yz",scalar(y_prime(1),z_prime(1)),
5364 c & " zz",scalar(z_prime(1),z_prime(1))
5366 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5367 C to local coordinate system. Store in xx, yy, zz.
5373 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5374 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5375 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5382 C Compute the energy of the ith side cbain
5384 c write (2,*) "xx",xx," yy",yy," zz",zz
5387 x(j) = sc_parmin(j,it)
5390 Cc diagnostics - remove later
5392 yy1 = dsin(alph(2))*dcos(omeg(2))
5393 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5394 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5395 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5397 C," --- ", xx_w,yy_w,zz_w
5400 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5401 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5403 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5404 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5406 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5407 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5408 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5409 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5410 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5412 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5413 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5414 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5415 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5416 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5418 dsc_i = 0.743d0+x(61)
5420 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5421 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5422 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5423 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5424 s1=(1+x(63))/(0.1d0 + dscp1)
5425 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5426 s2=(1+x(65))/(0.1d0 + dscp2)
5427 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5428 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5429 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5430 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5432 c & dscp1,dscp2,sumene
5433 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5434 escloc = escloc + sumene
5435 c write (2,*) "escloc",escloc
5436 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5438 if (.not. calc_grad) goto 1
5441 C This section to check the numerical derivatives of the energy of ith side
5442 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5443 C #define DEBUG in the code to turn it on.
5445 write (2,*) "sumene =",sumene
5449 write (2,*) xx,yy,zz
5450 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5451 de_dxx_num=(sumenep-sumene)/aincr
5453 write (2,*) "xx+ sumene from enesc=",sumenep
5456 write (2,*) xx,yy,zz
5457 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5458 de_dyy_num=(sumenep-sumene)/aincr
5460 write (2,*) "yy+ sumene from enesc=",sumenep
5463 write (2,*) xx,yy,zz
5464 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5465 de_dzz_num=(sumenep-sumene)/aincr
5467 write (2,*) "zz+ sumene from enesc=",sumenep
5468 costsave=cost2tab(i+1)
5469 sintsave=sint2tab(i+1)
5470 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5471 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5472 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5473 de_dt_num=(sumenep-sumene)/aincr
5474 write (2,*) " t+ sumene from enesc=",sumenep
5475 cost2tab(i+1)=costsave
5476 sint2tab(i+1)=sintsave
5477 C End of diagnostics section.
5480 C Compute the gradient of esc
5482 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5483 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5484 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5485 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5486 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5487 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5488 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5489 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5490 pom1=(sumene3*sint2tab(i+1)+sumene1)
5491 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5492 pom2=(sumene4*cost2tab(i+1)+sumene2)
5493 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5494 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5495 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5496 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5498 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5499 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5500 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5502 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5503 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5504 & +(pom1+pom2)*pom_dx
5506 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5509 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5510 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5511 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5513 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5514 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5515 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5516 & +x(59)*zz**2 +x(60)*xx*zz
5517 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5518 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5519 & +(pom1-pom2)*pom_dy
5521 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5524 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5525 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5526 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5527 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5528 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5529 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5530 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5531 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5533 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5536 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5537 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5538 & +pom1*pom_dt1+pom2*pom_dt2
5540 write(2,*), "de_dt = ", de_dt,de_dt_num
5544 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5545 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5546 cosfac2xx=cosfac2*xx
5547 sinfac2yy=sinfac2*yy
5549 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5551 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5553 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5554 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5555 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5556 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5557 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5558 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5559 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5560 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5561 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5562 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5566 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5567 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5568 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5569 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5572 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5573 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5574 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5576 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5577 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5581 dXX_Ctab(k,i)=dXX_Ci(k)
5582 dXX_C1tab(k,i)=dXX_Ci1(k)
5583 dYY_Ctab(k,i)=dYY_Ci(k)
5584 dYY_C1tab(k,i)=dYY_Ci1(k)
5585 dZZ_Ctab(k,i)=dZZ_Ci(k)
5586 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5587 dXX_XYZtab(k,i)=dXX_XYZ(k)
5588 dYY_XYZtab(k,i)=dYY_XYZ(k)
5589 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5593 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5594 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5595 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5596 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5597 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5599 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5600 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5601 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5602 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5603 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5604 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5605 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5606 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5608 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5609 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5611 C to check gradient call subroutine check_grad
5618 c------------------------------------------------------------------------------
5619 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5621 C This procedure calculates two-body contact function g(rij) and its derivative:
5624 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5627 C where x=(rij-r0ij)/delta
5629 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5632 double precision rij,r0ij,eps0ij,fcont,fprimcont
5633 double precision x,x2,x4,delta
5637 if (x.lt.-1.0D0) then
5640 else if (x.le.1.0D0) then
5643 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5644 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5651 c------------------------------------------------------------------------------
5652 subroutine splinthet(theti,delta,ss,ssder)
5653 implicit real*8 (a-h,o-z)
5654 include 'DIMENSIONS'
5655 include 'COMMON.VAR'
5656 include 'COMMON.GEO'
5659 if (theti.gt.pipol) then
5660 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5662 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5667 c------------------------------------------------------------------------------
5668 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5670 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5671 double precision ksi,ksi2,ksi3,a1,a2,a3
5672 a1=fprim0*delta/(f1-f0)
5678 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5679 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5682 c------------------------------------------------------------------------------
5683 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5685 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5686 double precision ksi,ksi2,ksi3,a1,a2,a3
5691 a2=3*(f1x-f0x)-2*fprim0x*delta
5692 a3=fprim0x*delta-2*(f1x-f0x)
5693 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5696 C-----------------------------------------------------------------------------
5698 C-----------------------------------------------------------------------------
5699 subroutine etor(etors,fact)
5700 implicit real*8 (a-h,o-z)
5701 include 'DIMENSIONS'
5702 include 'COMMON.VAR'
5703 include 'COMMON.GEO'
5704 include 'COMMON.LOCAL'
5705 include 'COMMON.TORSION'
5706 include 'COMMON.INTERACT'
5707 include 'COMMON.DERIV'
5708 include 'COMMON.CHAIN'
5709 include 'COMMON.NAMES'
5710 include 'COMMON.IOUNITS'
5711 include 'COMMON.FFIELD'
5712 include 'COMMON.TORCNSTR'
5714 C Set lprn=.true. for debugging
5718 do i=iphi_start,iphi_end
5719 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5720 & .or. itype(i).eq.ntyp1) cycle
5721 itori=itortyp(itype(i-2))
5722 itori1=itortyp(itype(i-1))
5725 C Proline-Proline pair is a special case...
5726 if (itori.eq.3 .and. itori1.eq.3) then
5727 if (phii.gt.-dwapi3) then
5729 fac=1.0D0/(1.0D0-cosphi)
5730 etorsi=v1(1,3,3)*fac
5731 etorsi=etorsi+etorsi
5732 etors=etors+etorsi-v1(1,3,3)
5733 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5736 v1ij=v1(j+1,itori,itori1)
5737 v2ij=v2(j+1,itori,itori1)
5740 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5741 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5745 v1ij=v1(j,itori,itori1)
5746 v2ij=v2(j,itori,itori1)
5749 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5750 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5754 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5755 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5756 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5757 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5758 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5762 c------------------------------------------------------------------------------
5764 subroutine etor(etors,fact)
5765 implicit real*8 (a-h,o-z)
5766 include 'DIMENSIONS'
5767 include 'COMMON.VAR'
5768 include 'COMMON.GEO'
5769 include 'COMMON.LOCAL'
5770 include 'COMMON.TORSION'
5771 include 'COMMON.INTERACT'
5772 include 'COMMON.DERIV'
5773 include 'COMMON.CHAIN'
5774 include 'COMMON.NAMES'
5775 include 'COMMON.IOUNITS'
5776 include 'COMMON.FFIELD'
5777 include 'COMMON.TORCNSTR'
5779 C Set lprn=.true. for debugging
5783 do i=iphi_start,iphi_end
5785 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5786 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5787 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5788 C & .or. itype(i).eq.ntyp1) cycle
5789 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5790 if (iabs(itype(i)).eq.20) then
5795 itori=itortyp(itype(i-2))
5796 itori1=itortyp(itype(i-1))
5799 C Regular cosine and sine terms
5800 do j=1,nterm(itori,itori1,iblock)
5801 v1ij=v1(j,itori,itori1,iblock)
5802 v2ij=v2(j,itori,itori1,iblock)
5805 etors=etors+v1ij*cosphi+v2ij*sinphi
5806 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5810 C E = SUM ----------------------------------- - v1
5811 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5813 cosphi=dcos(0.5d0*phii)
5814 sinphi=dsin(0.5d0*phii)
5815 do j=1,nlor(itori,itori1,iblock)
5816 vl1ij=vlor1(j,itori,itori1)
5817 vl2ij=vlor2(j,itori,itori1)
5818 vl3ij=vlor3(j,itori,itori1)
5819 pom=vl2ij*cosphi+vl3ij*sinphi
5820 pom1=1.0d0/(pom*pom+1.0d0)
5821 etors=etors+vl1ij*pom1
5822 c if (energy_dec) etors_ii=etors_ii+
5825 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5827 C Subtract the constant term
5828 etors=etors-v0(itori,itori1,iblock)
5830 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5831 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5832 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5833 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5834 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5839 c----------------------------------------------------------------------------
5840 subroutine etor_d(etors_d,fact2)
5841 C 6/23/01 Compute double torsional energy
5842 implicit real*8 (a-h,o-z)
5843 include 'DIMENSIONS'
5844 include 'COMMON.VAR'
5845 include 'COMMON.GEO'
5846 include 'COMMON.LOCAL'
5847 include 'COMMON.TORSION'
5848 include 'COMMON.INTERACT'
5849 include 'COMMON.DERIV'
5850 include 'COMMON.CHAIN'
5851 include 'COMMON.NAMES'
5852 include 'COMMON.IOUNITS'
5853 include 'COMMON.FFIELD'
5854 include 'COMMON.TORCNSTR'
5856 C Set lprn=.true. for debugging
5860 do i=iphi_start,iphi_end-1
5862 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5863 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5864 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5865 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5866 & (itype(i+1).eq.ntyp1)) cycle
5867 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5869 itori=itortyp(itype(i-2))
5870 itori1=itortyp(itype(i-1))
5871 itori2=itortyp(itype(i))
5877 if (iabs(itype(i+1)).eq.20) iblock=2
5878 C Regular cosine and sine terms
5879 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5880 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5881 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5882 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5883 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5884 cosphi1=dcos(j*phii)
5885 sinphi1=dsin(j*phii)
5886 cosphi2=dcos(j*phii1)
5887 sinphi2=dsin(j*phii1)
5888 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5889 & v2cij*cosphi2+v2sij*sinphi2
5890 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5891 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5893 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5895 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5896 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5897 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5898 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5899 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5900 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5901 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5902 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5903 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5904 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5905 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5906 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5907 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5908 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5911 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5912 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5918 c---------------------------------------------------------------------------
5919 C The rigorous attempt to derive energy function
5920 subroutine etor_kcc(etors,fact)
5921 implicit real*8 (a-h,o-z)
5922 include 'DIMENSIONS'
5923 include 'COMMON.VAR'
5924 include 'COMMON.GEO'
5925 include 'COMMON.LOCAL'
5926 include 'COMMON.TORSION'
5927 include 'COMMON.INTERACT'
5928 include 'COMMON.DERIV'
5929 include 'COMMON.CHAIN'
5930 include 'COMMON.NAMES'
5931 include 'COMMON.IOUNITS'
5932 include 'COMMON.FFIELD'
5933 include 'COMMON.TORCNSTR'
5934 include 'COMMON.CONTROL'
5935 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
5937 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
5938 C Set lprn=.true. for debugging
5941 C print *,"wchodze kcc"
5942 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
5944 do i=iphi_start,iphi_end
5945 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5946 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5947 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5948 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5949 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5950 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5951 itori=itortyp(itype(i-2))
5952 itori1=itortyp(itype(i-1))
5957 C to avoid multiple devision by 2
5958 c theti22=0.5d0*theta(i)
5959 C theta 12 is the theta_1 /2
5960 C theta 22 is theta_2 /2
5961 c theti12=0.5d0*theta(i-1)
5962 C and appropriate sinus function
5963 sinthet1=dsin(theta(i-1))
5964 sinthet2=dsin(theta(i))
5965 costhet1=dcos(theta(i-1))
5966 costhet2=dcos(theta(i))
5967 C to speed up lets store its mutliplication
5968 sint1t2=sinthet2*sinthet1
5970 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
5971 C +d_n*sin(n*gamma)) *
5972 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
5973 C we have two sum 1) Non-Chebyshev which is with n and gamma
5974 nval=nterm_kcc_Tb(itori,itori1)
5980 c1(j)=c1(j-1)*costhet1
5981 c2(j)=c2(j-1)*costhet2
5984 do j=1,nterm_kcc(itori,itori1)
5988 sint1t2n=sint1t2n*sint1t2
5994 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5995 gradvalct1=gradvalct1+
5996 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5997 gradvalct2=gradvalct2+
5998 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6001 gradvalct1=-gradvalct1*sinthet1
6002 gradvalct2=-gradvalct2*sinthet2
6008 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6009 gradvalst1=gradvalst1+
6010 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6011 gradvalst2=gradvalst2+
6012 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6015 gradvalst1=-gradvalst1*sinthet1
6016 gradvalst2=-gradvalst2*sinthet2
6017 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6018 C glocig is the gradient local i site in gamma
6019 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6020 C now gradient over theta_1
6021 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6022 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6023 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6024 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6027 C derivative over gamma
6028 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6029 C derivative over theta1
6030 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6031 C now derivative over theta2
6032 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6034 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6035 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6039 c---------------------------------------------------------------------------------------------
6040 subroutine etor_constr(edihcnstr)
6041 implicit real*8 (a-h,o-z)
6042 include 'DIMENSIONS'
6043 include 'COMMON.VAR'
6044 include 'COMMON.GEO'
6045 include 'COMMON.LOCAL'
6046 include 'COMMON.TORSION'
6047 include 'COMMON.INTERACT'
6048 include 'COMMON.DERIV'
6049 include 'COMMON.CHAIN'
6050 include 'COMMON.NAMES'
6051 include 'COMMON.IOUNITS'
6052 include 'COMMON.FFIELD'
6053 include 'COMMON.TORCNSTR'
6054 include 'COMMON.CONTROL'
6055 ! 6/20/98 - dihedral angle constraints
6057 c do i=1,ndih_constr
6058 c write (iout,*) "idihconstr_start",idihconstr_start,
6059 c & " idihconstr_end",idihconstr_end
6060 if (raw_psipred) then
6061 do i=idihconstr_start,idihconstr_end
6062 itori=idih_constr(i)
6064 gaudih_i=vpsipred(1,i)
6068 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6069 dexpcos_i=dexp(-cos_i*cos_i)
6070 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6071 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6072 & *cos_i*dexpcos_i/s**2
6074 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6075 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6077 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6078 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6079 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6080 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6081 & -wdihc*dlog(gaudih_i)
6084 do i=idihconstr_start,idihconstr_end
6085 itori=idih_constr(i)
6087 difi=pinorm(phii-phi0(i))
6088 if (difi.gt.drange(i)) then
6090 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6091 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6092 else if (difi.lt.-drange(i)) then
6094 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6095 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6103 c----------------------------------------------------------------------------
6104 C The rigorous attempt to derive energy function
6105 subroutine ebend_kcc(etheta)
6107 implicit real*8 (a-h,o-z)
6108 include 'DIMENSIONS'
6109 include 'COMMON.VAR'
6110 include 'COMMON.GEO'
6111 include 'COMMON.LOCAL'
6112 include 'COMMON.TORSION'
6113 include 'COMMON.INTERACT'
6114 include 'COMMON.DERIV'
6115 include 'COMMON.CHAIN'
6116 include 'COMMON.NAMES'
6117 include 'COMMON.IOUNITS'
6118 include 'COMMON.FFIELD'
6119 include 'COMMON.TORCNSTR'
6120 include 'COMMON.CONTROL'
6122 double precision thybt1(maxang_kcc)
6123 C Set lprn=.true. for debugging
6126 C print *,"wchodze kcc"
6127 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6129 do i=ithet_start,ithet_end
6130 c print *,i,itype(i-1),itype(i),itype(i-2)
6131 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6132 & .or.itype(i).eq.ntyp1) cycle
6133 iti=iabs(itortyp(itype(i-1)))
6134 sinthet=dsin(theta(i))
6135 costhet=dcos(theta(i))
6136 do j=1,nbend_kcc_Tb(iti)
6137 thybt1(j)=v1bend_chyb(j,iti)
6139 sumth1thyb=v1bend_chyb(0,iti)+
6140 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6141 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6143 ihelp=nbend_kcc_Tb(iti)-1
6144 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6145 etheta=etheta+sumth1thyb
6146 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6147 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6151 c-------------------------------------------------------------------------------------
6152 subroutine etheta_constr(ethetacnstr)
6154 implicit real*8 (a-h,o-z)
6155 include 'DIMENSIONS'
6156 include 'COMMON.VAR'
6157 include 'COMMON.GEO'
6158 include 'COMMON.LOCAL'
6159 include 'COMMON.TORSION'
6160 include 'COMMON.INTERACT'
6161 include 'COMMON.DERIV'
6162 include 'COMMON.CHAIN'
6163 include 'COMMON.NAMES'
6164 include 'COMMON.IOUNITS'
6165 include 'COMMON.FFIELD'
6166 include 'COMMON.TORCNSTR'
6167 include 'COMMON.CONTROL'
6169 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6170 do i=ithetaconstr_start,ithetaconstr_end
6171 itheta=itheta_constr(i)
6172 thetiii=theta(itheta)
6173 difi=pinorm(thetiii-theta_constr0(i))
6174 if (difi.gt.theta_drange(i)) then
6175 difi=difi-theta_drange(i)
6176 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6177 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6178 & +for_thet_constr(i)*difi**3
6179 else if (difi.lt.-drange(i)) then
6181 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6182 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6183 & +for_thet_constr(i)*difi**3
6187 if (energy_dec) then
6188 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6189 & i,itheta,rad2deg*thetiii,
6190 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6191 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6192 & gloc(itheta+nphi-2,icg)
6197 c------------------------------------------------------------------------------
6198 c------------------------------------------------------------------------------
6199 subroutine eback_sc_corr(esccor)
6200 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6201 c conformational states; temporarily implemented as differences
6202 c between UNRES torsional potentials (dependent on three types of
6203 c residues) and the torsional potentials dependent on all 20 types
6204 c of residues computed from AM1 energy surfaces of terminally-blocked
6205 c amino-acid residues.
6206 implicit real*8 (a-h,o-z)
6207 include 'DIMENSIONS'
6208 include 'COMMON.VAR'
6209 include 'COMMON.GEO'
6210 include 'COMMON.LOCAL'
6211 include 'COMMON.TORSION'
6212 include 'COMMON.SCCOR'
6213 include 'COMMON.INTERACT'
6214 include 'COMMON.DERIV'
6215 include 'COMMON.CHAIN'
6216 include 'COMMON.NAMES'
6217 include 'COMMON.IOUNITS'
6218 include 'COMMON.FFIELD'
6219 include 'COMMON.CONTROL'
6221 C Set lprn=.true. for debugging
6224 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6226 do i=itau_start,itau_end
6227 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6229 isccori=isccortyp(itype(i-2))
6230 isccori1=isccortyp(itype(i-1))
6232 do intertyp=1,3 !intertyp
6233 cc Added 09 May 2012 (Adasko)
6234 cc Intertyp means interaction type of backbone mainchain correlation:
6235 c 1 = SC...Ca...Ca...Ca
6236 c 2 = Ca...Ca...Ca...SC
6237 c 3 = SC...Ca...Ca...SCi
6239 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6240 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6241 & (itype(i-1).eq.ntyp1)))
6242 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6243 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6244 & .or.(itype(i).eq.ntyp1)))
6245 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6246 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6247 & (itype(i-3).eq.ntyp1)))) cycle
6248 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6249 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6251 do j=1,nterm_sccor(isccori,isccori1)
6252 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6253 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6254 cosphi=dcos(j*tauangle(intertyp,i))
6255 sinphi=dsin(j*tauangle(intertyp,i))
6256 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6257 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6259 C write (iout,*)"EBACK_SC_COR",esccor,i
6260 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6261 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6262 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6264 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6265 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6266 & (v1sccor(j,1,itori,itori1),j=1,6)
6267 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6268 c gsccor_loc(i-3)=gloci
6273 c------------------------------------------------------------------------------
6274 subroutine multibody(ecorr)
6275 C This subroutine calculates multi-body contributions to energy following
6276 C the idea of Skolnick et al. If side chains I and J make a contact and
6277 C at the same time side chains I+1 and J+1 make a contact, an extra
6278 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6279 implicit real*8 (a-h,o-z)
6280 include 'DIMENSIONS'
6281 include 'COMMON.IOUNITS'
6282 include 'COMMON.DERIV'
6283 include 'COMMON.INTERACT'
6284 include 'COMMON.CONTACTS'
6285 double precision gx(3),gx1(3)
6288 C Set lprn=.true. for debugging
6292 write (iout,'(a)') 'Contact function values:'
6294 write (iout,'(i2,20(1x,i2,f10.5))')
6295 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6310 num_conti=num_cont(i)
6311 num_conti1=num_cont(i1)
6316 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6317 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6318 cd & ' ishift=',ishift
6319 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6320 C The system gains extra energy.
6321 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6322 endif ! j1==j+-ishift
6331 c------------------------------------------------------------------------------
6332 double precision function esccorr(i,j,k,l,jj,kk)
6333 implicit real*8 (a-h,o-z)
6334 include 'DIMENSIONS'
6335 include 'COMMON.IOUNITS'
6336 include 'COMMON.DERIV'
6337 include 'COMMON.INTERACT'
6338 include 'COMMON.CONTACTS'
6339 double precision gx(3),gx1(3)
6344 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6345 C Calculate the multi-body contribution to energy.
6346 C Calculate multi-body contributions to the gradient.
6347 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6348 cd & k,l,(gacont(m,kk,k),m=1,3)
6350 gx(m) =ekl*gacont(m,jj,i)
6351 gx1(m)=eij*gacont(m,kk,k)
6352 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6353 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6354 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6355 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6359 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6364 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6370 c------------------------------------------------------------------------------
6371 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6372 C This subroutine calculates multi-body contributions to hydrogen-bonding
6373 implicit real*8 (a-h,o-z)
6374 include 'DIMENSIONS'
6375 include 'COMMON.IOUNITS'
6376 include 'COMMON.FFIELD'
6377 include 'COMMON.DERIV'
6378 include 'COMMON.INTERACT'
6379 include 'COMMON.CONTACTS'
6380 double precision gx(3),gx1(3)
6383 C Set lprn=.true. for debugging
6386 write (iout,'(a)') 'Contact function values:'
6388 write (iout,'(2i3,50(1x,i2,f5.2))')
6389 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6390 & j=1,num_cont_hb(i))
6394 C Remove the loop below after debugging !!!
6401 C Calculate the local-electrostatic correlation terms
6402 do i=iatel_s,iatel_e+1
6404 num_conti=num_cont_hb(i)
6405 num_conti1=num_cont_hb(i+1)
6410 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6411 c & ' jj=',jj,' kk=',kk
6412 if (j1.eq.j+1 .or. j1.eq.j-1) then
6413 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6414 C The system gains extra energy.
6415 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6417 else if (j1.eq.j) then
6418 C Contacts I-J and I-(J+1) occur simultaneously.
6419 C The system loses extra energy.
6420 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6425 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6426 c & ' jj=',jj,' kk=',kk
6428 C Contacts I-J and (I+1)-J occur simultaneously.
6429 C The system loses extra energy.
6430 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6437 c------------------------------------------------------------------------------
6438 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6440 C This subroutine calculates multi-body contributions to hydrogen-bonding
6441 implicit real*8 (a-h,o-z)
6442 include 'DIMENSIONS'
6443 include 'COMMON.IOUNITS'
6447 include 'COMMON.FFIELD'
6448 include 'COMMON.DERIV'
6449 include 'COMMON.LOCAL'
6450 include 'COMMON.INTERACT'
6451 include 'COMMON.CONTACTS'
6452 include 'COMMON.CHAIN'
6453 include 'COMMON.CONTROL'
6454 include 'COMMON.SHIELD'
6455 double precision gx(3),gx1(3)
6456 integer num_cont_hb_old(maxres)
6458 double precision eello4,eello5,eelo6,eello_turn6
6459 external eello4,eello5,eello6,eello_turn6
6460 C Set lprn=.true. for debugging
6464 write (iout,'(a)') 'Contact function values:'
6466 write (iout,'(2i3,50(1x,i2,5f6.3))')
6467 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6468 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6474 C Remove the loop below after debugging !!!
6481 C Calculate the dipole-dipole interaction energies
6482 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6483 do i=iatel_s,iatel_e+1
6484 num_conti=num_cont_hb(i)
6493 C Calculate the local-electrostatic correlation terms
6494 c write (iout,*) "gradcorr5 in eello5 before loop"
6496 c write (iout,'(i5,3f10.5)')
6497 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6499 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6500 c write (iout,*) "corr loop i",i
6502 num_conti=num_cont_hb(i)
6503 num_conti1=num_cont_hb(i+1)
6510 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6511 c & ' jj=',jj,' kk=',kk
6512 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6513 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6514 & .or. j.lt.0 .and. j1.gt.0) .and.
6515 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6516 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6517 C The system gains extra energy.
6519 sqd1=dsqrt(d_cont(jj,i))
6520 sqd2=dsqrt(d_cont(kk,i1))
6521 sred_geom = sqd1*sqd2
6522 IF (sred_geom.lt.cutoff_corr) THEN
6523 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6525 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6526 cd & ' jj=',jj,' kk=',kk
6527 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6528 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6530 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6531 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6534 cd write (iout,*) 'sred_geom=',sred_geom,
6535 cd & ' ekont=',ekont,' fprim=',fprimcont,
6536 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6537 cd write (iout,*) "g_contij",g_contij
6538 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6539 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6540 call calc_eello(i,jp,i+1,jp1,jj,kk)
6541 if (wcorr4.gt.0.0d0)
6542 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6543 CC & *fac_shield(i)**2*fac_shield(j)**2
6544 if (energy_dec.and.wcorr4.gt.0.0d0)
6545 1 write (iout,'(a6,4i5,0pf7.3)')
6546 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6547 c write (iout,*) "gradcorr5 before eello5"
6549 c write (iout,'(i5,3f10.5)')
6550 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6552 if (wcorr5.gt.0.0d0)
6553 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6554 c write (iout,*) "gradcorr5 after eello5"
6556 c write (iout,'(i5,3f10.5)')
6557 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6559 if (energy_dec.and.wcorr5.gt.0.0d0)
6560 1 write (iout,'(a6,4i5,0pf7.3)')
6561 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6562 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6563 cd write(2,*)'ijkl',i,jp,i+1,jp1
6564 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6565 & .or. wturn6.eq.0.0d0))then
6566 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6567 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6568 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6569 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6570 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6571 cd & 'ecorr6=',ecorr6
6572 cd write (iout,'(4e15.5)') sred_geom,
6573 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6574 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6575 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6576 else if (wturn6.gt.0.0d0
6577 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6578 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6579 eturn6=eturn6+eello_turn6(i,jj,kk)
6580 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6581 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6582 cd write (2,*) 'multibody_eello:eturn6',eturn6
6591 num_cont_hb(i)=num_cont_hb_old(i)
6593 c write (iout,*) "gradcorr5 in eello5"
6595 c write (iout,'(i5,3f10.5)')
6596 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6600 c------------------------------------------------------------------------------
6601 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6602 implicit real*8 (a-h,o-z)
6603 include 'DIMENSIONS'
6604 include 'COMMON.IOUNITS'
6605 include 'COMMON.DERIV'
6606 include 'COMMON.INTERACT'
6607 include 'COMMON.CONTACTS'
6608 include 'COMMON.SHIELD'
6609 include 'COMMON.CONTROL'
6610 double precision gx(3),gx1(3)
6613 C print *,"wchodze",fac_shield(i),shield_mode
6621 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6623 C & fac_shield(i)**2*fac_shield(j)**2
6624 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6625 C Following 4 lines for diagnostics.
6630 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6631 c & 'Contacts ',i,j,
6632 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6633 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6635 C Calculate the multi-body contribution to energy.
6636 C ecorr=ecorr+ekont*ees
6637 C Calculate multi-body contributions to the gradient.
6638 coeffpees0pij=coeffp*ees0pij
6639 coeffmees0mij=coeffm*ees0mij
6640 coeffpees0pkl=coeffp*ees0pkl
6641 coeffmees0mkl=coeffm*ees0mkl
6643 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6644 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6645 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6646 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6647 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6648 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6649 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6650 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6651 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6652 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6653 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6654 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6655 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6656 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6657 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6658 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6659 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6660 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6661 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6662 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6663 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6664 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6665 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6666 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6667 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6672 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6673 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6674 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6675 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6680 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6681 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6682 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6683 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6686 c write (iout,*) "ehbcorr",ekont*ees
6687 C print *,ekont,ees,i,k
6689 C now gradient over shielding
6691 if (shield_mode.gt.0) then
6694 C print *,i,j,fac_shield(i),fac_shield(j),
6695 C &fac_shield(k),fac_shield(l)
6696 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6697 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6698 do ilist=1,ishield_list(i)
6699 iresshield=shield_list(ilist,i)
6701 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6703 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6705 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6706 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6710 do ilist=1,ishield_list(j)
6711 iresshield=shield_list(ilist,j)
6713 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6715 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6717 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6718 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6723 do ilist=1,ishield_list(k)
6724 iresshield=shield_list(ilist,k)
6726 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6728 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6730 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6731 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6735 do ilist=1,ishield_list(l)
6736 iresshield=shield_list(ilist,l)
6738 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6740 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6742 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6743 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6747 C print *,gshieldx(m,iresshield)
6749 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6750 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6751 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6752 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6753 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6754 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6755 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6756 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6758 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6759 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6760 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6761 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6762 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6763 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6764 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6765 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6773 C---------------------------------------------------------------------------
6774 subroutine dipole(i,j,jj)
6775 implicit real*8 (a-h,o-z)
6776 include 'DIMENSIONS'
6777 include 'COMMON.IOUNITS'
6778 include 'COMMON.CHAIN'
6779 include 'COMMON.FFIELD'
6780 include 'COMMON.DERIV'
6781 include 'COMMON.INTERACT'
6782 include 'COMMON.CONTACTS'
6783 include 'COMMON.TORSION'
6784 include 'COMMON.VAR'
6785 include 'COMMON.GEO'
6786 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6788 iti1 = itortyp(itype(i+1))
6789 if (j.lt.nres-1) then
6790 itj1 = itype2loc(itype(j+1))
6795 dipi(iii,1)=Ub2(iii,i)
6796 dipderi(iii)=Ub2der(iii,i)
6797 dipi(iii,2)=b1(iii,i+1)
6798 dipj(iii,1)=Ub2(iii,j)
6799 dipderj(iii)=Ub2der(iii,j)
6800 dipj(iii,2)=b1(iii,j+1)
6804 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6807 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6814 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6818 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6823 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6824 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6826 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6828 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6830 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6835 C---------------------------------------------------------------------------
6836 subroutine calc_eello(i,j,k,l,jj,kk)
6838 C This subroutine computes matrices and vectors needed to calculate
6839 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6841 implicit real*8 (a-h,o-z)
6842 include 'DIMENSIONS'
6843 include 'COMMON.IOUNITS'
6844 include 'COMMON.CHAIN'
6845 include 'COMMON.DERIV'
6846 include 'COMMON.INTERACT'
6847 include 'COMMON.CONTACTS'
6848 include 'COMMON.TORSION'
6849 include 'COMMON.VAR'
6850 include 'COMMON.GEO'
6851 include 'COMMON.FFIELD'
6852 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6853 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6856 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6857 cd & ' jj=',jj,' kk=',kk
6858 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6859 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6860 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6863 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6864 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6867 call transpose2(aa1(1,1),aa1t(1,1))
6868 call transpose2(aa2(1,1),aa2t(1,1))
6871 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6872 & aa1tder(1,1,lll,kkk))
6873 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6874 & aa2tder(1,1,lll,kkk))
6878 C parallel orientation of the two CA-CA-CA frames.
6880 iti=itype2loc(itype(i))
6884 itk1=itype2loc(itype(k+1))
6885 itj=itype2loc(itype(j))
6886 if (l.lt.nres-1) then
6887 itl1=itype2loc(itype(l+1))
6891 C A1 kernel(j+1) A2T
6893 cd write (iout,'(3f10.5,5x,3f10.5)')
6894 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6896 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6897 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6898 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6899 C Following matrices are needed only for 6-th order cumulants
6900 IF (wcorr6.gt.0.0d0) THEN
6901 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6902 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6903 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6904 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6905 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6906 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6907 & ADtEAderx(1,1,1,1,1,1))
6909 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6910 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6911 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6912 & ADtEA1derx(1,1,1,1,1,1))
6914 C End 6-th order cumulants
6917 cd write (2,*) 'In calc_eello6'
6919 cd write (2,*) 'iii=',iii
6921 cd write (2,*) 'kkk=',kkk
6923 cd write (2,'(3(2f10.5),5x)')
6924 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6929 call transpose2(EUgder(1,1,k),auxmat(1,1))
6930 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6931 call transpose2(EUg(1,1,k),auxmat(1,1))
6932 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6933 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6937 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6938 & EAEAderx(1,1,lll,kkk,iii,1))
6942 C A1T kernel(i+1) A2
6943 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6944 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6945 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6946 C Following matrices are needed only for 6-th order cumulants
6947 IF (wcorr6.gt.0.0d0) THEN
6948 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6949 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6950 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6951 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6952 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6953 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6954 & ADtEAderx(1,1,1,1,1,2))
6955 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6956 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6957 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6958 & ADtEA1derx(1,1,1,1,1,2))
6960 C End 6-th order cumulants
6961 call transpose2(EUgder(1,1,l),auxmat(1,1))
6962 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6963 call transpose2(EUg(1,1,l),auxmat(1,1))
6964 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6965 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6969 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6970 & EAEAderx(1,1,lll,kkk,iii,2))
6975 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6976 C They are needed only when the fifth- or the sixth-order cumulants are
6978 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6979 call transpose2(AEA(1,1,1),auxmat(1,1))
6980 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
6981 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6982 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6983 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6984 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
6985 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6986 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
6987 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
6988 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6989 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6990 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6991 call transpose2(AEA(1,1,2),auxmat(1,1))
6992 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
6993 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6994 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6995 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6996 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
6997 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6998 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
6999 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7000 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7001 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7002 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7003 C Calculate the Cartesian derivatives of the vectors.
7007 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7008 call matvec2(auxmat(1,1),b1(1,i),
7009 & AEAb1derx(1,lll,kkk,iii,1,1))
7010 call matvec2(auxmat(1,1),Ub2(1,i),
7011 & AEAb2derx(1,lll,kkk,iii,1,1))
7012 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7013 & AEAb1derx(1,lll,kkk,iii,2,1))
7014 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7015 & AEAb2derx(1,lll,kkk,iii,2,1))
7016 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7017 call matvec2(auxmat(1,1),b1(1,j),
7018 & AEAb1derx(1,lll,kkk,iii,1,2))
7019 call matvec2(auxmat(1,1),Ub2(1,j),
7020 & AEAb2derx(1,lll,kkk,iii,1,2))
7021 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7022 & AEAb1derx(1,lll,kkk,iii,2,2))
7023 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7024 & AEAb2derx(1,lll,kkk,iii,2,2))
7031 C Antiparallel orientation of the two CA-CA-CA frames.
7033 iti=itype2loc(itype(i))
7037 itk1=itype2loc(itype(k+1))
7038 itl=itype2loc(itype(l))
7039 itj=itype2loc(itype(j))
7040 if (j.lt.nres-1) then
7041 itj1=itype2loc(itype(j+1))
7045 C A2 kernel(j-1)T A1T
7046 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7047 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7048 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7049 C Following matrices are needed only for 6-th order cumulants
7050 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7051 & j.eq.i+4 .and. l.eq.i+3)) THEN
7052 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7053 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7054 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7055 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7056 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7057 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7058 & ADtEAderx(1,1,1,1,1,1))
7059 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7060 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7061 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7062 & ADtEA1derx(1,1,1,1,1,1))
7064 C End 6-th order cumulants
7065 call transpose2(EUgder(1,1,k),auxmat(1,1))
7066 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7067 call transpose2(EUg(1,1,k),auxmat(1,1))
7068 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7069 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7073 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7074 & EAEAderx(1,1,lll,kkk,iii,1))
7078 C A2T kernel(i+1)T A1
7079 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7080 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7081 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7082 C Following matrices are needed only for 6-th order cumulants
7083 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7084 & j.eq.i+4 .and. l.eq.i+3)) THEN
7085 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7086 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7087 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7088 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7089 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7090 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7091 & ADtEAderx(1,1,1,1,1,2))
7092 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7093 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7094 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7095 & ADtEA1derx(1,1,1,1,1,2))
7097 C End 6-th order cumulants
7098 call transpose2(EUgder(1,1,j),auxmat(1,1))
7099 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7100 call transpose2(EUg(1,1,j),auxmat(1,1))
7101 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7102 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7106 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7107 & EAEAderx(1,1,lll,kkk,iii,2))
7112 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7113 C They are needed only when the fifth- or the sixth-order cumulants are
7115 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7116 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7117 call transpose2(AEA(1,1,1),auxmat(1,1))
7118 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7119 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7120 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7121 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7122 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7123 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7124 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7125 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7126 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7127 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7128 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7129 call transpose2(AEA(1,1,2),auxmat(1,1))
7130 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7131 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7132 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7133 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7134 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7135 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7136 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7137 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7138 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7139 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7140 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7141 C Calculate the Cartesian derivatives of the vectors.
7145 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7146 call matvec2(auxmat(1,1),b1(1,i),
7147 & AEAb1derx(1,lll,kkk,iii,1,1))
7148 call matvec2(auxmat(1,1),Ub2(1,i),
7149 & AEAb2derx(1,lll,kkk,iii,1,1))
7150 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7151 & AEAb1derx(1,lll,kkk,iii,2,1))
7152 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7153 & AEAb2derx(1,lll,kkk,iii,2,1))
7154 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7155 call matvec2(auxmat(1,1),b1(1,l),
7156 & AEAb1derx(1,lll,kkk,iii,1,2))
7157 call matvec2(auxmat(1,1),Ub2(1,l),
7158 & AEAb2derx(1,lll,kkk,iii,1,2))
7159 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7160 & AEAb1derx(1,lll,kkk,iii,2,2))
7161 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7162 & AEAb2derx(1,lll,kkk,iii,2,2))
7171 C---------------------------------------------------------------------------
7172 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7173 & KK,KKderg,AKA,AKAderg,AKAderx)
7177 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7178 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7179 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7184 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7186 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7189 cd if (lprn) write (2,*) 'In kernel'
7191 cd if (lprn) write (2,*) 'kkk=',kkk
7193 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7194 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7196 cd write (2,*) 'lll=',lll
7197 cd write (2,*) 'iii=1'
7199 cd write (2,'(3(2f10.5),5x)')
7200 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7203 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7204 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7206 cd write (2,*) 'lll=',lll
7207 cd write (2,*) 'iii=2'
7209 cd write (2,'(3(2f10.5),5x)')
7210 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7217 C---------------------------------------------------------------------------
7218 double precision function eello4(i,j,k,l,jj,kk)
7219 implicit real*8 (a-h,o-z)
7220 include 'DIMENSIONS'
7221 include 'COMMON.IOUNITS'
7222 include 'COMMON.CHAIN'
7223 include 'COMMON.DERIV'
7224 include 'COMMON.INTERACT'
7225 include 'COMMON.CONTACTS'
7226 include 'COMMON.TORSION'
7227 include 'COMMON.VAR'
7228 include 'COMMON.GEO'
7229 double precision pizda(2,2),ggg1(3),ggg2(3)
7230 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7234 cd print *,'eello4:',i,j,k,l,jj,kk
7235 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7236 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7237 cold eij=facont_hb(jj,i)
7238 cold ekl=facont_hb(kk,k)
7240 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7242 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7243 gcorr_loc(k-1)=gcorr_loc(k-1)
7244 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7246 gcorr_loc(l-1)=gcorr_loc(l-1)
7247 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7249 gcorr_loc(j-1)=gcorr_loc(j-1)
7250 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7255 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7256 & -EAEAderx(2,2,lll,kkk,iii,1)
7257 cd derx(lll,kkk,iii)=0.0d0
7261 cd gcorr_loc(l-1)=0.0d0
7262 cd gcorr_loc(j-1)=0.0d0
7263 cd gcorr_loc(k-1)=0.0d0
7265 cd write (iout,*)'Contacts have occurred for peptide groups',
7266 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7267 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7268 if (j.lt.nres-1) then
7275 if (l.lt.nres-1) then
7283 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7284 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7285 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7286 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7287 cgrad ghalf=0.5d0*ggg1(ll)
7288 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7289 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7290 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7291 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7292 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7293 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7294 cgrad ghalf=0.5d0*ggg2(ll)
7295 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7296 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7297 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7298 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7299 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7300 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7304 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7309 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7314 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7319 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7323 cd write (2,*) iii,gcorr_loc(iii)
7327 cd write (2,*) 'ekont',ekont
7328 cd write (iout,*) 'eello4',ekont*eel4
7331 C---------------------------------------------------------------------------
7332 double precision function eello5(i,j,k,l,jj,kk)
7333 implicit real*8 (a-h,o-z)
7334 include 'DIMENSIONS'
7335 include 'COMMON.IOUNITS'
7336 include 'COMMON.CHAIN'
7337 include 'COMMON.DERIV'
7338 include 'COMMON.INTERACT'
7339 include 'COMMON.CONTACTS'
7340 include 'COMMON.TORSION'
7341 include 'COMMON.VAR'
7342 include 'COMMON.GEO'
7343 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7344 double precision ggg1(3),ggg2(3)
7345 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7350 C /l\ / \ \ / \ / \ / C
7351 C / \ / \ \ / \ / \ / C
7352 C j| o |l1 | o | o| o | | o |o C
7353 C \ |/k\| |/ \| / |/ \| |/ \| C
7354 C \i/ \ / \ / / \ / \ C
7356 C (I) (II) (III) (IV) C
7358 C eello5_1 eello5_2 eello5_3 eello5_4 C
7360 C Antiparallel chains C
7363 C /j\ / \ \ / \ / \ / C
7364 C / \ / \ \ / \ / \ / C
7365 C j1| o |l | o | o| o | | o |o C
7366 C \ |/k\| |/ \| / |/ \| |/ \| C
7367 C \i/ \ / \ / / \ / \ C
7369 C (I) (II) (III) (IV) C
7371 C eello5_1 eello5_2 eello5_3 eello5_4 C
7373 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7375 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7376 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7381 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7383 itk=itype2loc(itype(k))
7384 itl=itype2loc(itype(l))
7385 itj=itype2loc(itype(j))
7390 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7391 cd & eel5_3_num,eel5_4_num)
7395 derx(lll,kkk,iii)=0.0d0
7399 cd eij=facont_hb(jj,i)
7400 cd ekl=facont_hb(kk,k)
7402 cd write (iout,*)'Contacts have occurred for peptide groups',
7403 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7405 C Contribution from the graph I.
7406 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7407 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7408 call transpose2(EUg(1,1,k),auxmat(1,1))
7409 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7410 vv(1)=pizda(1,1)-pizda(2,2)
7411 vv(2)=pizda(1,2)+pizda(2,1)
7412 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7413 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7415 C Explicit gradient in virtual-dihedral angles.
7416 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7417 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7418 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7419 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7420 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7421 vv(1)=pizda(1,1)-pizda(2,2)
7422 vv(2)=pizda(1,2)+pizda(2,1)
7423 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7424 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7425 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7426 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7427 vv(1)=pizda(1,1)-pizda(2,2)
7428 vv(2)=pizda(1,2)+pizda(2,1)
7430 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7431 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7432 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7434 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7435 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7436 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7438 C Cartesian gradient
7442 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7444 vv(1)=pizda(1,1)-pizda(2,2)
7445 vv(2)=pizda(1,2)+pizda(2,1)
7446 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7447 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7448 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7455 C Contribution from graph II
7456 call transpose2(EE(1,1,k),auxmat(1,1))
7457 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7458 vv(1)=pizda(1,1)+pizda(2,2)
7459 vv(2)=pizda(2,1)-pizda(1,2)
7460 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7461 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7463 C Explicit gradient in virtual-dihedral angles.
7464 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7465 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7466 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7467 vv(1)=pizda(1,1)+pizda(2,2)
7468 vv(2)=pizda(2,1)-pizda(1,2)
7470 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7471 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7472 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7474 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7475 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7476 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7478 C Cartesian gradient
7482 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7484 vv(1)=pizda(1,1)+pizda(2,2)
7485 vv(2)=pizda(2,1)-pizda(1,2)
7486 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7487 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7488 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7497 C Parallel orientation
7498 C Contribution from graph III
7499 call transpose2(EUg(1,1,l),auxmat(1,1))
7500 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7501 vv(1)=pizda(1,1)-pizda(2,2)
7502 vv(2)=pizda(1,2)+pizda(2,1)
7503 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7504 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7506 C Explicit gradient in virtual-dihedral angles.
7507 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7508 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7509 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7510 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7511 vv(1)=pizda(1,1)-pizda(2,2)
7512 vv(2)=pizda(1,2)+pizda(2,1)
7513 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7514 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7515 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7516 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7517 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7518 vv(1)=pizda(1,1)-pizda(2,2)
7519 vv(2)=pizda(1,2)+pizda(2,1)
7520 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7521 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7522 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7523 C Cartesian gradient
7527 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7529 vv(1)=pizda(1,1)-pizda(2,2)
7530 vv(2)=pizda(1,2)+pizda(2,1)
7531 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7532 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7533 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7538 C Contribution from graph IV
7540 call transpose2(EE(1,1,l),auxmat(1,1))
7541 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7542 vv(1)=pizda(1,1)+pizda(2,2)
7543 vv(2)=pizda(2,1)-pizda(1,2)
7544 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7545 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7546 C Explicit gradient in virtual-dihedral angles.
7547 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7548 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7549 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7550 vv(1)=pizda(1,1)+pizda(2,2)
7551 vv(2)=pizda(2,1)-pizda(1,2)
7552 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7553 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7554 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7555 C Cartesian gradient
7559 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7561 vv(1)=pizda(1,1)+pizda(2,2)
7562 vv(2)=pizda(2,1)-pizda(1,2)
7563 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7564 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7565 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7571 C Antiparallel orientation
7572 C Contribution from graph III
7574 call transpose2(EUg(1,1,j),auxmat(1,1))
7575 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7576 vv(1)=pizda(1,1)-pizda(2,2)
7577 vv(2)=pizda(1,2)+pizda(2,1)
7578 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7579 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7581 C Explicit gradient in virtual-dihedral angles.
7582 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7583 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7584 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7585 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7586 vv(1)=pizda(1,1)-pizda(2,2)
7587 vv(2)=pizda(1,2)+pizda(2,1)
7588 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7589 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7590 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7591 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7592 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7593 vv(1)=pizda(1,1)-pizda(2,2)
7594 vv(2)=pizda(1,2)+pizda(2,1)
7595 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7596 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7597 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7598 C Cartesian gradient
7602 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7604 vv(1)=pizda(1,1)-pizda(2,2)
7605 vv(2)=pizda(1,2)+pizda(2,1)
7606 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7607 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7608 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7614 C Contribution from graph IV
7616 call transpose2(EE(1,1,j),auxmat(1,1))
7617 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7618 vv(1)=pizda(1,1)+pizda(2,2)
7619 vv(2)=pizda(2,1)-pizda(1,2)
7620 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7621 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7623 C Explicit gradient in virtual-dihedral angles.
7624 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7625 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7626 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7627 vv(1)=pizda(1,1)+pizda(2,2)
7628 vv(2)=pizda(2,1)-pizda(1,2)
7629 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7630 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7631 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7632 C Cartesian gradient
7636 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7638 vv(1)=pizda(1,1)+pizda(2,2)
7639 vv(2)=pizda(2,1)-pizda(1,2)
7640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7641 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7642 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7649 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7650 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7651 cd write (2,*) 'ijkl',i,j,k,l
7652 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7653 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7655 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7656 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7657 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7658 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7660 if (j.lt.nres-1) then
7667 if (l.lt.nres-1) then
7677 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7678 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7679 C summed up outside the subrouine as for the other subroutines
7680 C handling long-range interactions. The old code is commented out
7681 C with "cgrad" to keep track of changes.
7683 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7684 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7685 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7686 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7687 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7688 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7689 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7690 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7691 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7692 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7694 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7695 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7696 cgrad ghalf=0.5d0*ggg1(ll)
7698 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7699 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7700 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7701 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7702 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7703 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7704 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7705 cgrad ghalf=0.5d0*ggg2(ll)
7707 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7708 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7709 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7710 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7711 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7712 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7718 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7719 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7724 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7725 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7731 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7736 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7740 cd write (2,*) iii,g_corr5_loc(iii)
7743 cd write (2,*) 'ekont',ekont
7744 cd write (iout,*) 'eello5',ekont*eel5
7747 c--------------------------------------------------------------------------
7748 double precision function eello6(i,j,k,l,jj,kk)
7749 implicit real*8 (a-h,o-z)
7750 include 'DIMENSIONS'
7751 include 'COMMON.IOUNITS'
7752 include 'COMMON.CHAIN'
7753 include 'COMMON.DERIV'
7754 include 'COMMON.INTERACT'
7755 include 'COMMON.CONTACTS'
7756 include 'COMMON.TORSION'
7757 include 'COMMON.VAR'
7758 include 'COMMON.GEO'
7759 include 'COMMON.FFIELD'
7760 double precision ggg1(3),ggg2(3)
7761 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7766 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7774 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7775 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7779 derx(lll,kkk,iii)=0.0d0
7783 cd eij=facont_hb(jj,i)
7784 cd ekl=facont_hb(kk,k)
7790 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7791 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7792 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7793 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7794 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7795 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7797 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7798 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7799 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7800 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7801 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7802 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7806 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7808 C If turn contributions are considered, they will be handled separately.
7809 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7810 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7811 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7812 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7813 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7814 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7815 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7818 if (j.lt.nres-1) then
7825 if (l.lt.nres-1) then
7833 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7834 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7835 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7836 cgrad ghalf=0.5d0*ggg1(ll)
7838 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7839 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7840 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7841 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7842 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7843 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7844 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7845 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7846 cgrad ghalf=0.5d0*ggg2(ll)
7847 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7849 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7850 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7851 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7852 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7853 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7854 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7860 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7861 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7866 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7867 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7873 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7878 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7882 cd write (2,*) iii,g_corr6_loc(iii)
7885 cd write (2,*) 'ekont',ekont
7886 cd write (iout,*) 'eello6',ekont*eel6
7889 c--------------------------------------------------------------------------
7890 double precision function eello6_graph1(i,j,k,l,imat,swap)
7891 implicit real*8 (a-h,o-z)
7892 include 'DIMENSIONS'
7893 include 'COMMON.IOUNITS'
7894 include 'COMMON.CHAIN'
7895 include 'COMMON.DERIV'
7896 include 'COMMON.INTERACT'
7897 include 'COMMON.CONTACTS'
7898 include 'COMMON.TORSION'
7899 include 'COMMON.VAR'
7900 include 'COMMON.GEO'
7901 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7905 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7907 C Parallel Antiparallel C
7913 C \ j|/k\| / \ |/k\|l / C
7918 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7919 itk=itype2loc(itype(k))
7920 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7921 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7922 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7923 call transpose2(EUgC(1,1,k),auxmat(1,1))
7924 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7925 vv1(1)=pizda1(1,1)-pizda1(2,2)
7926 vv1(2)=pizda1(1,2)+pizda1(2,1)
7927 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7928 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
7929 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
7930 s5=scalar2(vv(1),Dtobr2(1,i))
7931 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7932 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7934 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7935 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7936 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7937 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7938 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7939 & +scalar2(vv(1),Dtobr2der(1,i)))
7940 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7941 vv1(1)=pizda1(1,1)-pizda1(2,2)
7942 vv1(2)=pizda1(1,2)+pizda1(2,1)
7943 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
7944 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
7946 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7947 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7948 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7949 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7950 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7952 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7953 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7954 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7955 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7956 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7958 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7959 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7960 vv1(1)=pizda1(1,1)-pizda1(2,2)
7961 vv1(2)=pizda1(1,2)+pizda1(2,1)
7962 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7963 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7964 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7965 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7974 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7975 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7976 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7977 call transpose2(EUgC(1,1,k),auxmat(1,1))
7978 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7980 vv1(1)=pizda1(1,1)-pizda1(2,2)
7981 vv1(2)=pizda1(1,2)+pizda1(2,1)
7982 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7983 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
7984 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
7985 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
7986 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
7987 s5=scalar2(vv(1),Dtobr2(1,i))
7988 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7995 c----------------------------------------------------------------------------
7996 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7997 implicit real*8 (a-h,o-z)
7998 include 'DIMENSIONS'
7999 include 'COMMON.IOUNITS'
8000 include 'COMMON.CHAIN'
8001 include 'COMMON.DERIV'
8002 include 'COMMON.INTERACT'
8003 include 'COMMON.CONTACTS'
8004 include 'COMMON.TORSION'
8005 include 'COMMON.VAR'
8006 include 'COMMON.GEO'
8008 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8009 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8012 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8014 C Parallel Antiparallel C
8020 C \ j|/k\| \ |/k\|l C
8025 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8026 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8027 C AL 7/4/01 s1 would occur in the sixth-order moment,
8028 C but not in a cluster cumulant
8030 s1=dip(1,jj,i)*dip(1,kk,k)
8032 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8033 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8034 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8035 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8036 call transpose2(EUg(1,1,k),auxmat(1,1))
8037 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8038 vv(1)=pizda(1,1)-pizda(2,2)
8039 vv(2)=pizda(1,2)+pizda(2,1)
8040 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8041 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8043 eello6_graph2=-(s1+s2+s3+s4)
8045 eello6_graph2=-(s2+s3+s4)
8048 C Derivatives in gamma(i-1)
8052 s1=dipderg(1,jj,i)*dip(1,kk,k)
8054 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8055 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8056 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8057 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8059 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8061 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8063 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8065 C Derivatives in gamma(k-1)
8067 s1=dip(1,jj,i)*dipderg(1,kk,k)
8069 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8070 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8071 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8072 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8073 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8074 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8075 vv(1)=pizda(1,1)-pizda(2,2)
8076 vv(2)=pizda(1,2)+pizda(2,1)
8077 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8079 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8081 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8083 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8084 C Derivatives in gamma(j-1) or gamma(l-1)
8087 s1=dipderg(3,jj,i)*dip(1,kk,k)
8089 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8090 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8091 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8092 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8093 vv(1)=pizda(1,1)-pizda(2,2)
8094 vv(2)=pizda(1,2)+pizda(2,1)
8095 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8098 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8100 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8103 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8104 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8106 C Derivatives in gamma(l-1) or gamma(j-1)
8109 s1=dip(1,jj,i)*dipderg(3,kk,k)
8111 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8112 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8113 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8114 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8115 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8116 vv(1)=pizda(1,1)-pizda(2,2)
8117 vv(2)=pizda(1,2)+pizda(2,1)
8118 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8121 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8123 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8126 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8127 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8129 C Cartesian derivatives.
8131 write (2,*) 'In eello6_graph2'
8133 write (2,*) 'iii=',iii
8135 write (2,*) 'kkk=',kkk
8137 write (2,'(3(2f10.5),5x)')
8138 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8148 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8150 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8153 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8155 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8156 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8158 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8159 call transpose2(EUg(1,1,k),auxmat(1,1))
8160 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8162 vv(1)=pizda(1,1)-pizda(2,2)
8163 vv(2)=pizda(1,2)+pizda(2,1)
8164 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8165 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8167 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8169 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8172 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8174 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8182 c----------------------------------------------------------------------------
8183 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8184 implicit real*8 (a-h,o-z)
8185 include 'DIMENSIONS'
8186 include 'COMMON.IOUNITS'
8187 include 'COMMON.CHAIN'
8188 include 'COMMON.DERIV'
8189 include 'COMMON.INTERACT'
8190 include 'COMMON.CONTACTS'
8191 include 'COMMON.TORSION'
8192 include 'COMMON.VAR'
8193 include 'COMMON.GEO'
8194 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8196 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8198 C Parallel Antiparallel C
8204 C j|/k\| / |/k\|l / C
8209 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8211 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8212 C energy moment and not to the cluster cumulant.
8213 iti=itortyp(itype(i))
8214 if (j.lt.nres-1) then
8215 itj1=itype2loc(itype(j+1))
8219 itk=itype2loc(itype(k))
8220 itk1=itype2loc(itype(k+1))
8221 if (l.lt.nres-1) then
8222 itl1=itype2loc(itype(l+1))
8227 s1=dip(4,jj,i)*dip(4,kk,k)
8229 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8230 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8231 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8232 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8233 call transpose2(EE(1,1,k),auxmat(1,1))
8234 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8235 vv(1)=pizda(1,1)+pizda(2,2)
8236 vv(2)=pizda(2,1)-pizda(1,2)
8237 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8238 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8239 cd & "sum",-(s2+s3+s4)
8241 eello6_graph3=-(s1+s2+s3+s4)
8243 eello6_graph3=-(s2+s3+s4)
8246 C Derivatives in gamma(k-1)
8248 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8249 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8250 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8251 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8252 C Derivatives in gamma(l-1)
8253 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8254 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8255 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8256 vv(1)=pizda(1,1)+pizda(2,2)
8257 vv(2)=pizda(2,1)-pizda(1,2)
8258 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8259 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8260 C Cartesian derivatives.
8266 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8268 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8271 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8273 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8274 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8276 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8277 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8279 vv(1)=pizda(1,1)+pizda(2,2)
8280 vv(2)=pizda(2,1)-pizda(1,2)
8281 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8283 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8285 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8288 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8290 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8292 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8299 c----------------------------------------------------------------------------
8300 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8301 implicit real*8 (a-h,o-z)
8302 include 'DIMENSIONS'
8303 include 'COMMON.IOUNITS'
8304 include 'COMMON.CHAIN'
8305 include 'COMMON.DERIV'
8306 include 'COMMON.INTERACT'
8307 include 'COMMON.CONTACTS'
8308 include 'COMMON.TORSION'
8309 include 'COMMON.VAR'
8310 include 'COMMON.GEO'
8311 include 'COMMON.FFIELD'
8312 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8313 & auxvec1(2),auxmat1(2,2)
8315 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8317 C Parallel Antiparallel C
8323 C \ j|/k\| \ |/k\|l C
8328 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8330 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8331 C energy moment and not to the cluster cumulant.
8332 cd write (2,*) 'eello_graph4: wturn6',wturn6
8333 iti=itype2loc(itype(i))
8334 itj=itype2loc(itype(j))
8335 if (j.lt.nres-1) then
8336 itj1=itype2loc(itype(j+1))
8340 itk=itype2loc(itype(k))
8341 if (k.lt.nres-1) then
8342 itk1=itype2loc(itype(k+1))
8346 itl=itype2loc(itype(l))
8347 if (l.lt.nres-1) then
8348 itl1=itype2loc(itype(l+1))
8352 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8353 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8354 cd & ' itl',itl,' itl1',itl1
8357 s1=dip(3,jj,i)*dip(3,kk,k)
8359 s1=dip(2,jj,j)*dip(2,kk,l)
8362 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8363 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8365 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8366 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8368 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8369 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8371 call transpose2(EUg(1,1,k),auxmat(1,1))
8372 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8373 vv(1)=pizda(1,1)-pizda(2,2)
8374 vv(2)=pizda(2,1)+pizda(1,2)
8375 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8376 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8378 eello6_graph4=-(s1+s2+s3+s4)
8380 eello6_graph4=-(s2+s3+s4)
8382 C Derivatives in gamma(i-1)
8387 s1=dipderg(2,jj,i)*dip(3,kk,k)
8389 s1=dipderg(4,jj,j)*dip(2,kk,l)
8392 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8394 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8395 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8397 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8398 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8400 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8401 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8402 cd write (2,*) 'turn6 derivatives'
8404 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8406 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8410 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8412 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8416 C Derivatives in gamma(k-1)
8419 s1=dip(3,jj,i)*dipderg(2,kk,k)
8421 s1=dip(2,jj,j)*dipderg(4,kk,l)
8424 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8425 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8427 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8428 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8430 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8431 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8433 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8434 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8435 vv(1)=pizda(1,1)-pizda(2,2)
8436 vv(2)=pizda(2,1)+pizda(1,2)
8437 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8438 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8440 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8442 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8446 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8448 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8451 C Derivatives in gamma(j-1) or gamma(l-1)
8452 if (l.eq.j+1 .and. l.gt.1) then
8453 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8454 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8455 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8456 vv(1)=pizda(1,1)-pizda(2,2)
8457 vv(2)=pizda(2,1)+pizda(1,2)
8458 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8459 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8460 else if (j.gt.1) then
8461 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8462 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8463 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8464 vv(1)=pizda(1,1)-pizda(2,2)
8465 vv(2)=pizda(2,1)+pizda(1,2)
8466 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8467 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8468 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8470 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8473 C Cartesian derivatives.
8480 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8482 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8486 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8488 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8492 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8494 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8496 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8497 & b1(1,j+1),auxvec(1))
8498 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8500 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8501 & b1(1,l+1),auxvec(1))
8502 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8504 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8506 vv(1)=pizda(1,1)-pizda(2,2)
8507 vv(2)=pizda(2,1)+pizda(1,2)
8508 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8510 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8512 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8515 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8518 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8521 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8523 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8525 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8529 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8531 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8534 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8536 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8545 c----------------------------------------------------------------------------
8546 double precision function eello_turn6(i,jj,kk)
8547 implicit real*8 (a-h,o-z)
8548 include 'DIMENSIONS'
8549 include 'COMMON.IOUNITS'
8550 include 'COMMON.CHAIN'
8551 include 'COMMON.DERIV'
8552 include 'COMMON.INTERACT'
8553 include 'COMMON.CONTACTS'
8554 include 'COMMON.TORSION'
8555 include 'COMMON.VAR'
8556 include 'COMMON.GEO'
8557 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8558 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8560 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8561 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8562 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8563 C the respective energy moment and not to the cluster cumulant.
8572 iti=itype2loc(itype(i))
8573 itk=itype2loc(itype(k))
8574 itk1=itype2loc(itype(k+1))
8575 itl=itype2loc(itype(l))
8576 itj=itype2loc(itype(j))
8577 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8578 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8579 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8584 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8586 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8590 derx_turn(lll,kkk,iii)=0.0d0
8597 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8599 cd write (2,*) 'eello6_5',eello6_5
8601 call transpose2(AEA(1,1,1),auxmat(1,1))
8602 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8603 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8604 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8606 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8607 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8608 s2 = scalar2(b1(1,k),vtemp1(1))
8610 call transpose2(AEA(1,1,2),atemp(1,1))
8611 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8612 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8613 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8615 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8616 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8617 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8619 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8620 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8621 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8622 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8623 ss13 = scalar2(b1(1,k),vtemp4(1))
8624 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8626 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8632 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8633 C Derivatives in gamma(i+2)
8638 call transpose2(AEA(1,1,1),auxmatd(1,1))
8639 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8640 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8641 call transpose2(AEAderg(1,1,2),atempd(1,1))
8642 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8643 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8645 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8646 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8647 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8653 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8654 C Derivatives in gamma(i+3)
8656 call transpose2(AEA(1,1,1),auxmatd(1,1))
8657 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8658 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8659 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8661 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8662 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8663 s2d = scalar2(b1(1,k),vtemp1d(1))
8665 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8666 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8668 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8670 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8671 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8672 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8680 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8681 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8683 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8684 & -0.5d0*ekont*(s2d+s12d)
8686 C Derivatives in gamma(i+4)
8687 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8688 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8689 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8691 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8692 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8693 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8701 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8703 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8705 C Derivatives in gamma(i+5)
8707 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8708 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8709 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8711 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8712 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8713 s2d = scalar2(b1(1,k),vtemp1d(1))
8715 call transpose2(AEA(1,1,2),atempd(1,1))
8716 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8717 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8719 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8720 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8722 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8723 ss13d = scalar2(b1(1,k),vtemp4d(1))
8724 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8732 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8733 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8735 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8736 & -0.5d0*ekont*(s2d+s12d)
8738 C Cartesian derivatives
8743 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8744 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8745 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8747 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8748 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8750 s2d = scalar2(b1(1,k),vtemp1d(1))
8752 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8753 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8754 s8d = -(atempd(1,1)+atempd(2,2))*
8755 & scalar2(cc(1,1,l),vtemp2(1))
8757 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8759 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8760 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8767 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8770 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8774 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8775 & - 0.5d0*(s8d+s12d)
8777 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8786 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8788 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8789 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8790 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8791 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8792 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8794 ss13d = scalar2(b1(1,k),vtemp4d(1))
8795 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8796 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8800 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8801 cd & 16*eel_turn6_num
8803 if (j.lt.nres-1) then
8810 if (l.lt.nres-1) then
8818 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8819 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8820 cgrad ghalf=0.5d0*ggg1(ll)
8822 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8823 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8824 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8825 & +ekont*derx_turn(ll,2,1)
8826 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8827 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8828 & +ekont*derx_turn(ll,4,1)
8829 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8830 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8831 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8832 cgrad ghalf=0.5d0*ggg2(ll)
8834 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8835 & +ekont*derx_turn(ll,2,2)
8836 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8837 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8838 & +ekont*derx_turn(ll,4,2)
8839 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8840 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8841 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8846 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8851 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8857 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8862 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8866 cd write (2,*) iii,g_corr6_loc(iii)
8869 eello_turn6=ekont*eel_turn6
8870 cd write (2,*) 'ekont',ekont
8871 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8875 crc-------------------------------------------------
8876 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8877 subroutine Eliptransfer(eliptran)
8878 implicit real*8 (a-h,o-z)
8879 include 'DIMENSIONS'
8880 include 'COMMON.GEO'
8881 include 'COMMON.VAR'
8882 include 'COMMON.LOCAL'
8883 include 'COMMON.CHAIN'
8884 include 'COMMON.DERIV'
8885 include 'COMMON.INTERACT'
8886 include 'COMMON.IOUNITS'
8887 include 'COMMON.CALC'
8888 include 'COMMON.CONTROL'
8889 include 'COMMON.SPLITELE'
8890 include 'COMMON.SBRIDGE'
8891 C this is done by Adasko
8895 C--bordliptop-- buffore starts
8896 C--bufliptop--- here true lipid starts
8898 C--buflipbot--- lipid ends buffore starts
8899 C--bordlipbot--buffore ends
8903 if (itype(i).eq.ntyp1) cycle
8905 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8906 if (positi.le.0) positi=positi+boxzsize
8908 C first for peptide groups
8909 c for each residue check if it is in lipid or lipid water border area
8910 if ((positi.gt.bordlipbot)
8911 &.and.(positi.lt.bordliptop)) then
8912 C the energy transfer exist
8913 if (positi.lt.buflipbot) then
8914 C what fraction I am in
8916 & ((positi-bordlipbot)/lipbufthick)
8917 C lipbufthick is thickenes of lipid buffore
8918 sslip=sscalelip(fracinbuf)
8919 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8920 eliptran=eliptran+sslip*pepliptran
8921 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8922 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8923 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8924 elseif (positi.gt.bufliptop) then
8925 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8926 sslip=sscalelip(fracinbuf)
8927 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8928 eliptran=eliptran+sslip*pepliptran
8929 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8930 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8931 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8932 C print *, "doing sscalefor top part"
8933 C print *,i,sslip,fracinbuf,ssgradlip
8935 eliptran=eliptran+pepliptran
8936 C print *,"I am in true lipid"
8939 C eliptran=elpitran+0.0 ! I am in water
8942 C print *, "nic nie bylo w lipidzie?"
8943 C now multiply all by the peptide group transfer factor
8944 C eliptran=eliptran*pepliptran
8945 C now the same for side chains
8948 if (itype(i).eq.ntyp1) cycle
8949 positi=(mod(c(3,i+nres),boxzsize))
8950 if (positi.le.0) positi=positi+boxzsize
8951 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8952 c for each residue check if it is in lipid or lipid water border area
8953 C respos=mod(c(3,i+nres),boxzsize)
8954 C print *,positi,bordlipbot,buflipbot
8955 if ((positi.gt.bordlipbot)
8956 & .and.(positi.lt.bordliptop)) then
8957 C the energy transfer exist
8958 if (positi.lt.buflipbot) then
8960 & ((positi-bordlipbot)/lipbufthick)
8961 C lipbufthick is thickenes of lipid buffore
8962 sslip=sscalelip(fracinbuf)
8963 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8964 eliptran=eliptran+sslip*liptranene(itype(i))
8965 gliptranx(3,i)=gliptranx(3,i)
8966 &+ssgradlip*liptranene(itype(i))
8967 gliptranc(3,i-1)= gliptranc(3,i-1)
8968 &+ssgradlip*liptranene(itype(i))
8969 C print *,"doing sccale for lower part"
8970 elseif (positi.gt.bufliptop) then
8972 &((bordliptop-positi)/lipbufthick)
8973 sslip=sscalelip(fracinbuf)
8974 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8975 eliptran=eliptran+sslip*liptranene(itype(i))
8976 gliptranx(3,i)=gliptranx(3,i)
8977 &+ssgradlip*liptranene(itype(i))
8978 gliptranc(3,i-1)= gliptranc(3,i-1)
8979 &+ssgradlip*liptranene(itype(i))
8980 C print *, "doing sscalefor top part",sslip,fracinbuf
8982 eliptran=eliptran+liptranene(itype(i))
8983 C print *,"I am in true lipid"
8985 endif ! if in lipid or buffor
8987 C eliptran=elpitran+0.0 ! I am in water
8993 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8995 SUBROUTINE MATVEC2(A1,V1,V2)
8996 implicit real*8 (a-h,o-z)
8997 include 'DIMENSIONS'
8998 DIMENSION A1(2,2),V1(2),V2(2)
9002 c 3 VI=VI+A1(I,K)*V1(K)
9006 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9007 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9012 C---------------------------------------
9013 SUBROUTINE MATMAT2(A1,A2,A3)
9014 implicit real*8 (a-h,o-z)
9015 include 'DIMENSIONS'
9016 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9017 c DIMENSION AI3(2,2)
9021 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9027 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9028 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9029 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9030 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9038 c-------------------------------------------------------------------------
9039 double precision function scalar2(u,v)
9041 double precision u(2),v(2)
9044 scalar2=u(1)*v(1)+u(2)*v(2)
9048 C-----------------------------------------------------------------------------
9050 subroutine transpose2(a,at)
9052 double precision a(2,2),at(2,2)
9059 c--------------------------------------------------------------------------
9060 subroutine transpose(n,a,at)
9063 double precision a(n,n),at(n,n)
9071 C---------------------------------------------------------------------------
9072 subroutine prodmat3(a1,a2,kk,transp,prod)
9075 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9077 crc double precision auxmat(2,2),prod_(2,2)
9080 crc call transpose2(kk(1,1),auxmat(1,1))
9081 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9082 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9084 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9085 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9086 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9087 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9088 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9089 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9090 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9091 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9094 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9095 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9097 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9098 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9099 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9100 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9101 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9102 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9103 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9104 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9107 c call transpose2(a2(1,1),a2t(1,1))
9110 crc print *,((prod_(i,j),i=1,2),j=1,2)
9111 crc print *,((prod(i,j),i=1,2),j=1,2)
9115 C-----------------------------------------------------------------------------
9116 double precision function scalar(u,v)
9118 double precision u(3),v(3)
9128 C-----------------------------------------------------------------------
9129 double precision function sscale(r)
9130 double precision r,gamm
9131 include "COMMON.SPLITELE"
9132 if(r.lt.r_cut-rlamb) then
9134 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9135 gamm=(r-(r_cut-rlamb))/rlamb
9136 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9142 C-----------------------------------------------------------------------
9143 C-----------------------------------------------------------------------
9144 double precision function sscagrad(r)
9145 double precision r,gamm
9146 include "COMMON.SPLITELE"
9147 if(r.lt.r_cut-rlamb) then
9149 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9150 gamm=(r-(r_cut-rlamb))/rlamb
9151 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9157 C-----------------------------------------------------------------------
9158 C-----------------------------------------------------------------------
9159 double precision function sscalelip(r)
9160 double precision r,gamm
9161 include "COMMON.SPLITELE"
9162 C if(r.lt.r_cut-rlamb) then
9164 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9165 C gamm=(r-(r_cut-rlamb))/rlamb
9166 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9172 C-----------------------------------------------------------------------
9173 double precision function sscagradlip(r)
9174 double precision r,gamm
9175 include "COMMON.SPLITELE"
9176 C if(r.lt.r_cut-rlamb) then
9178 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9179 C gamm=(r-(r_cut-rlamb))/rlamb
9180 sscagradlip=r*(6*r-6.0d0)
9187 C-----------------------------------------------------------------------
9188 subroutine set_shield_fac
9189 implicit real*8 (a-h,o-z)
9190 include 'DIMENSIONS'
9191 include 'COMMON.CHAIN'
9192 include 'COMMON.DERIV'
9193 include 'COMMON.IOUNITS'
9194 include 'COMMON.SHIELD'
9195 include 'COMMON.INTERACT'
9196 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9197 double precision div77_81/0.974996043d0/,
9198 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9200 C the vector between center of side_chain and peptide group
9201 double precision pep_side(3),long,side_calf(3),
9202 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9203 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9204 C the line belowe needs to be changed for FGPROC>1
9206 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9208 Cif there two consequtive dummy atoms there is no peptide group between them
9209 C the line below has to be changed for FGPROC>1
9212 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9216 C first lets set vector conecting the ithe side-chain with kth side-chain
9217 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9219 C and vector conecting the side-chain with its proper calfa
9220 side_calf(j)=c(j,k+nres)-c(j,k)
9221 C side_calf(j)=2.0d0
9222 pept_group(j)=c(j,i)-c(j,i+1)
9223 C lets have their lenght
9224 dist_pep_side=pep_side(j)**2+dist_pep_side
9225 dist_side_calf=dist_side_calf+side_calf(j)**2
9226 dist_pept_group=dist_pept_group+pept_group(j)**2
9228 dist_pep_side=dsqrt(dist_pep_side)
9229 dist_pept_group=dsqrt(dist_pept_group)
9230 dist_side_calf=dsqrt(dist_side_calf)
9232 pep_side_norm(j)=pep_side(j)/dist_pep_side
9233 side_calf_norm(j)=dist_side_calf
9235 C now sscale fraction
9236 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9237 C print *,buff_shield,"buff"
9239 if (sh_frac_dist.le.0.0) cycle
9240 C If we reach here it means that this side chain reaches the shielding sphere
9241 C Lets add him to the list for gradient
9242 ishield_list(i)=ishield_list(i)+1
9243 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9244 C this list is essential otherwise problem would be O3
9245 shield_list(ishield_list(i),i)=k
9246 C Lets have the sscale value
9247 if (sh_frac_dist.gt.1.0) then
9248 scale_fac_dist=1.0d0
9250 sh_frac_dist_grad(j)=0.0d0
9253 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9254 & *(2.0*sh_frac_dist-3.0d0)
9255 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9256 & /dist_pep_side/buff_shield*0.5
9257 C remember for the final gradient multiply sh_frac_dist_grad(j)
9258 C for side_chain by factor -2 !
9260 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9261 C print *,"jestem",scale_fac_dist,fac_help_scale,
9262 C & sh_frac_dist_grad(j)
9265 C if ((i.eq.3).and.(k.eq.2)) then
9266 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9270 C this is what is now we have the distance scaling now volume...
9271 short=short_r_sidechain(itype(k))
9272 long=long_r_sidechain(itype(k))
9273 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9276 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9279 costhet_grad(j)=costhet_fac*pep_side(j)
9281 C remember for the final gradient multiply costhet_grad(j)
9282 C for side_chain by factor -2 !
9283 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9284 C pep_side0pept_group is vector multiplication
9285 pep_side0pept_group=0.0
9287 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9289 cosalfa=(pep_side0pept_group/
9290 & (dist_pep_side*dist_side_calf))
9291 fac_alfa_sin=1.0-cosalfa**2
9292 fac_alfa_sin=dsqrt(fac_alfa_sin)
9293 rkprim=fac_alfa_sin*(long-short)+short
9295 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9296 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9299 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9300 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9301 &*(long-short)/fac_alfa_sin*cosalfa/
9302 &((dist_pep_side*dist_side_calf))*
9303 &((side_calf(j))-cosalfa*
9304 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9306 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9307 &*(long-short)/fac_alfa_sin*cosalfa
9308 &/((dist_pep_side*dist_side_calf))*
9310 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9313 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9316 C now the gradient...
9317 C grad_shield is gradient of Calfa for peptide groups
9318 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9320 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9321 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9323 grad_shield(j,i)=grad_shield(j,i)
9324 C gradient po skalowaniu
9325 & +(sh_frac_dist_grad(j)
9326 C gradient po costhet
9327 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9328 &-scale_fac_dist*(cosphi_grad_long(j))
9329 &/(1.0-cosphi) )*div77_81
9331 C grad_shield_side is Cbeta sidechain gradient
9332 grad_shield_side(j,ishield_list(i),i)=
9333 & (sh_frac_dist_grad(j)*(-2.0d0)
9334 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9335 & +scale_fac_dist*(cosphi_grad_long(j))
9336 & *2.0d0/(1.0-cosphi))
9337 & *div77_81*VofOverlap
9339 grad_shield_loc(j,ishield_list(i),i)=
9340 & scale_fac_dist*cosphi_grad_loc(j)
9341 & *2.0d0/(1.0-cosphi)
9342 & *div77_81*VofOverlap
9344 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9346 fac_shield(i)=VolumeTotal*div77_81+div4_81
9347 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9351 C--------------------------------------------------------------------------
9352 C first for shielding is setting of function of side-chains
9353 subroutine set_shield_fac2
9354 implicit real*8 (a-h,o-z)
9355 include 'DIMENSIONS'
9356 include 'COMMON.CHAIN'
9357 include 'COMMON.DERIV'
9358 include 'COMMON.IOUNITS'
9359 include 'COMMON.SHIELD'
9360 include 'COMMON.INTERACT'
9361 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9362 double precision div77_81/0.974996043d0/,
9363 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9365 C the vector between center of side_chain and peptide group
9366 double precision pep_side(3),long,side_calf(3),
9367 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9368 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9369 C the line belowe needs to be changed for FGPROC>1
9371 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9373 Cif there two consequtive dummy atoms there is no peptide group between them
9374 C the line below has to be changed for FGPROC>1
9377 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9381 C first lets set vector conecting the ithe side-chain with kth side-chain
9382 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9384 C and vector conecting the side-chain with its proper calfa
9385 side_calf(j)=c(j,k+nres)-c(j,k)
9386 C side_calf(j)=2.0d0
9387 pept_group(j)=c(j,i)-c(j,i+1)
9388 C lets have their lenght
9389 dist_pep_side=pep_side(j)**2+dist_pep_side
9390 dist_side_calf=dist_side_calf+side_calf(j)**2
9391 dist_pept_group=dist_pept_group+pept_group(j)**2
9393 dist_pep_side=dsqrt(dist_pep_side)
9394 dist_pept_group=dsqrt(dist_pept_group)
9395 dist_side_calf=dsqrt(dist_side_calf)
9397 pep_side_norm(j)=pep_side(j)/dist_pep_side
9398 side_calf_norm(j)=dist_side_calf
9400 C now sscale fraction
9401 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9402 C print *,buff_shield,"buff"
9404 if (sh_frac_dist.le.0.0) cycle
9405 C If we reach here it means that this side chain reaches the shielding sphere
9406 C Lets add him to the list for gradient
9407 ishield_list(i)=ishield_list(i)+1
9408 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9409 C this list is essential otherwise problem would be O3
9410 shield_list(ishield_list(i),i)=k
9411 C Lets have the sscale value
9412 if (sh_frac_dist.gt.1.0) then
9413 scale_fac_dist=1.0d0
9415 sh_frac_dist_grad(j)=0.0d0
9418 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9419 & *(2.0d0*sh_frac_dist-3.0d0)
9420 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9421 & /dist_pep_side/buff_shield*0.5d0
9422 C remember for the final gradient multiply sh_frac_dist_grad(j)
9423 C for side_chain by factor -2 !
9425 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9426 C sh_frac_dist_grad(j)=0.0d0
9427 C scale_fac_dist=1.0d0
9428 C print *,"jestem",scale_fac_dist,fac_help_scale,
9429 C & sh_frac_dist_grad(j)
9432 C this is what is now we have the distance scaling now volume...
9433 short=short_r_sidechain(itype(k))
9434 long=long_r_sidechain(itype(k))
9435 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9436 sinthet=short/dist_pep_side*costhet
9440 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9441 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9442 C & -short/dist_pep_side**2/costhet)
9445 costhet_grad(j)=costhet_fac*pep_side(j)
9447 C remember for the final gradient multiply costhet_grad(j)
9448 C for side_chain by factor -2 !
9449 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9450 C pep_side0pept_group is vector multiplication
9451 pep_side0pept_group=0.0d0
9453 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9455 cosalfa=(pep_side0pept_group/
9456 & (dist_pep_side*dist_side_calf))
9457 fac_alfa_sin=1.0d0-cosalfa**2
9458 fac_alfa_sin=dsqrt(fac_alfa_sin)
9459 rkprim=fac_alfa_sin*(long-short)+short
9463 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9465 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9466 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9470 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9471 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9472 &*(long-short)/fac_alfa_sin*cosalfa/
9473 &((dist_pep_side*dist_side_calf))*
9474 &((side_calf(j))-cosalfa*
9475 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9476 C cosphi_grad_long(j)=0.0d0
9477 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9478 &*(long-short)/fac_alfa_sin*cosalfa
9479 &/((dist_pep_side*dist_side_calf))*
9481 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9482 C cosphi_grad_loc(j)=0.0d0
9484 C print *,sinphi,sinthet
9485 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9488 C now the gradient...
9490 grad_shield(j,i)=grad_shield(j,i)
9491 C gradient po skalowaniu
9492 & +(sh_frac_dist_grad(j)*VofOverlap
9493 C gradient po costhet
9494 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9495 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9496 & sinphi/sinthet*costhet*costhet_grad(j)
9497 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9499 C grad_shield_side is Cbeta sidechain gradient
9500 grad_shield_side(j,ishield_list(i),i)=
9501 & (sh_frac_dist_grad(j)*(-2.0d0)
9503 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9504 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9505 & sinphi/sinthet*costhet*costhet_grad(j)
9506 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9509 grad_shield_loc(j,ishield_list(i),i)=
9510 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9511 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9512 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9516 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9518 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9519 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9520 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9524 C--------------------------------------------------------------------------
9525 double precision function tschebyshev(m,n,x,y)
9527 include "DIMENSIONS"
9529 double precision x(n),y,yy(0:maxvar),aux
9530 c Tschebyshev polynomial. Note that the first term is omitted
9531 c m=0: the constant term is included
9532 c m=1: the constant term is not included
9536 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9545 C--------------------------------------------------------------------------
9546 double precision function gradtschebyshev(m,n,x,y)
9548 include "DIMENSIONS"
9550 double precision x(n+1),y,yy(0:maxvar),aux
9551 c Tschebyshev polynomial. Note that the first term is omitted
9552 c m=0: the constant term is included
9553 c m=1: the constant term is not included
9557 yy(i)=2*y*yy(i-1)-yy(i-2)
9561 aux=aux+x(i+1)*yy(i)*(i+1)
9562 C print *, x(i+1),yy(i),i
9567 c----------------------------------------------------------------------------
9568 double precision function sscale2(r,r_cut,r0,rlamb)
9570 double precision r,gamm,r_cut,r0,rlamb,rr
9572 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9573 c write (2,*) "rr",rr
9574 if(rr.lt.r_cut-rlamb) then
9576 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9577 gamm=(rr-(r_cut-rlamb))/rlamb
9578 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9584 C-----------------------------------------------------------------------
9585 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9587 double precision r,gamm,r_cut,r0,rlamb,rr
9589 if(rr.lt.r_cut-rlamb) then
9591 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9592 gamm=(rr-(r_cut-rlamb))/rlamb
9594 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9596 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9603 c----------------------------------------------------------------------------
9604 subroutine e_saxs(Esaxs_constr)
9606 include 'DIMENSIONS'
9609 include "COMMON.SETUP"
9612 include 'COMMON.SBRIDGE'
9613 include 'COMMON.CHAIN'
9614 include 'COMMON.GEO'
9615 include 'COMMON.LOCAL'
9616 include 'COMMON.INTERACT'
9617 include 'COMMON.VAR'
9618 include 'COMMON.IOUNITS'
9619 include 'COMMON.DERIV'
9620 include 'COMMON.CONTROL'
9621 include 'COMMON.NAMES'
9622 include 'COMMON.FFIELD'
9623 include 'COMMON.LANGEVIN'
9624 include 'COMMON.SAXS'
9626 double precision Esaxs_constr
9627 integer i,iint,j,k,l
9628 double precision PgradC(maxSAXS,3,maxres),
9629 & PgradX(maxSAXS,3,maxres)
9631 double precision PgradC_(maxSAXS,3,maxres),
9632 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9634 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9635 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9636 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9637 & auxX,auxX1,CACAgrad,Cnorm
9638 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9639 double precision dist
9641 c SAXS restraint penalty function
9643 write(iout,*) "------- SAXS penalty function start -------"
9644 write (iout,*) "nsaxs",nsaxs
9645 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9646 write (iout,*) "Psaxs"
9648 write (iout,'(i5,e15.5)') i, Psaxs(i)
9651 Esaxs_constr = 0.0d0
9661 do i=iatsc_s,iatsc_e
9662 if (itype(i).eq.ntyp1) cycle
9663 do iint=1,nint_gr(i)
9664 do j=istart(i,iint),iend(i,iint)
9665 if (itype(j).eq.ntyp1) cycle
9668 dijCASC=dist(i,j+nres)
9669 dijSCCA=dist(i+nres,j)
9670 dijSCSC=dist(i+nres,j+nres)
9671 sigma2CACA=2.0d0/(pstok**2)
9672 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9673 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9674 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9677 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9678 if (itype(j).ne.10) then
9679 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9683 if (itype(i).ne.10) then
9684 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9688 if (itype(i).ne.10 .and. itype(j).ne.10) then
9689 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9693 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9695 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9697 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9698 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9699 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9700 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9703 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9704 PgradC(k,l,i) = PgradC(k,l,i)-aux
9705 PgradC(k,l,j) = PgradC(k,l,j)+aux
9707 if (itype(j).ne.10) then
9708 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9709 PgradC(k,l,i) = PgradC(k,l,i)-aux
9710 PgradC(k,l,j) = PgradC(k,l,j)+aux
9711 PgradX(k,l,j) = PgradX(k,l,j)+aux
9714 if (itype(i).ne.10) then
9715 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9716 PgradX(k,l,i) = PgradX(k,l,i)-aux
9717 PgradC(k,l,i) = PgradC(k,l,i)-aux
9718 PgradC(k,l,j) = PgradC(k,l,j)+aux
9721 if (itype(i).ne.10 .and. itype(j).ne.10) then
9722 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9723 PgradC(k,l,i) = PgradC(k,l,i)-aux
9724 PgradC(k,l,j) = PgradC(k,l,j)+aux
9725 PgradX(k,l,i) = PgradX(k,l,i)-aux
9726 PgradX(k,l,j) = PgradX(k,l,j)+aux
9732 sigma2CACA=scal_rad**2*0.25d0/
9733 & (restok(itype(j))**2+restok(itype(i))**2)
9735 IF (saxs_cutoff.eq.0) THEN
9738 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9739 Pcalc(k) = Pcalc(k)+expCACA
9740 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9742 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9743 PgradC(k,l,i) = PgradC(k,l,i)-aux
9744 PgradC(k,l,j) = PgradC(k,l,j)+aux
9748 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9751 c write (2,*) "ijk",i,j,k
9752 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9753 if (sss2.eq.0.0d0) cycle
9754 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9755 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9756 Pcalc(k) = Pcalc(k)+expCACA
9758 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9760 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9761 & ssgrad2*expCACA/sss2
9764 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9765 PgradC(k,l,i) = PgradC(k,l,i)+aux
9766 PgradC(k,l,j) = PgradC(k,l,j)-aux
9775 if (nfgtasks.gt.1) then
9776 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9777 & MPI_SUM,king,FG_COMM,IERR)
9778 if (fg_rank.eq.king) then
9780 Pcalc(k) = Pcalc_(k)
9783 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9784 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9785 if (fg_rank.eq.king) then
9789 PgradC(k,l,i) = PgradC_(k,l,i)
9795 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9796 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9797 if (fg_rank.eq.king) then
9801 PgradX(k,l,i) = PgradX_(k,l,i)
9810 if (fg_rank.eq.king) then
9814 Cnorm = Cnorm + Pcalc(k)
9816 Esaxs_constr = dlog(Cnorm)-wsaxs0
9818 if (Pcalc(k).gt.0.0d0)
9819 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9821 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9825 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9835 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9836 auxC1 = auxC1+PgradC(k,l,i)
9838 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9839 auxX1 = auxX1+PgradX(k,l,i)
9842 gsaxsC(l,i) = auxC - auxC1/Cnorm
9844 gsaxsX(l,i) = auxX - auxX1/Cnorm
9846 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9847 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9855 c----------------------------------------------------------------------------
9856 subroutine e_saxsC(Esaxs_constr)
9858 include 'DIMENSIONS'
9861 include "COMMON.SETUP"
9864 include 'COMMON.SBRIDGE'
9865 include 'COMMON.CHAIN'
9866 include 'COMMON.GEO'
9867 include 'COMMON.LOCAL'
9868 include 'COMMON.INTERACT'
9869 include 'COMMON.VAR'
9870 include 'COMMON.IOUNITS'
9871 include 'COMMON.DERIV'
9872 include 'COMMON.CONTROL'
9873 include 'COMMON.NAMES'
9874 include 'COMMON.FFIELD'
9875 include 'COMMON.LANGEVIN'
9876 include 'COMMON.SAXS'
9878 double precision Esaxs_constr
9879 integer i,iint,j,k,l
9880 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc_,logPtot
9882 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9884 double precision dk,dijCASPH,dijSCSPH,
9885 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9886 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
9888 c SAXS restraint penalty function
9890 write(iout,*) "------- SAXS penalty function start -------"
9891 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
9892 & " isaxs_end",isaxs_end
9893 write (iout,*) "nnt",nnt," ntc",nct
9895 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9896 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9899 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9902 Esaxs_constr = 0.0d0
9904 do j=isaxs_start,isaxs_end
9916 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9918 if (itype(i).ne.10) then
9920 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9923 sigma2CA=2.0d0/pstok**2
9924 sigma2SC=4.0d0/restok(itype(i))**2
9925 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9926 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9927 Pcalc_ = Pcalc_+expCASPH+expSCSPH
9929 write(*,*) "processor i j Pcalc",
9930 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc_
9932 CASPHgrad = sigma2CA*expCASPH
9933 SCSPHgrad = sigma2SC*expSCSPH
9935 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9936 PgradX(l,i) = PgradX(l,i) + aux
9937 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9942 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc_
9943 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc_
9946 logPtot = logPtot - dlog(Pcalc_)
9947 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc_),
9948 c & " logPtot",logPtot
9951 if (nfgtasks.gt.1) then
9952 c write (iout,*) "logPtot before reduction",logPtot
9953 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9954 & MPI_SUM,king,FG_COMM,IERR)
9956 c write (iout,*) "logPtot after reduction",logPtot
9957 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9958 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9959 if (fg_rank.eq.king) then
9962 gsaxsC(l,i) = gsaxsC_(l,i)
9966 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9967 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9968 if (fg_rank.eq.king) then
9971 gsaxsX(l,i) = gsaxsX_(l,i)
9977 Esaxs_constr = logPtot
9980 C--------------------------------------------------------------------------
9981 c MODELLER restraint function
9982 subroutine e_modeller(ehomology_constr)
9983 implicit real*8 (a-h,o-z)
9984 include 'DIMENSIONS'
9985 integer nnn, i, j, k, ki, irec, l
9986 integer katy, odleglosci, test7
9987 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
9988 real*8 distance(max_template),distancek(max_template),
9989 & min_odl,godl(max_template),dih_diff(max_template)
9992 c FP - 30/10/2014 Temporary specifications for homology restraints
9994 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
9996 double precision, dimension (maxres) :: guscdiff,usc_diff
9997 double precision, dimension (max_template) ::
9998 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
10001 include 'COMMON.SBRIDGE'
10002 include 'COMMON.CHAIN'
10003 include 'COMMON.GEO'
10004 include 'COMMON.DERIV'
10005 include 'COMMON.LOCAL'
10006 include 'COMMON.INTERACT'
10007 include 'COMMON.VAR'
10008 include 'COMMON.IOUNITS'
10009 include 'COMMON.CONTROL'
10010 include 'COMMON.HOMRESTR'
10011 include 'COMMON.HOMOLOGY'
10012 include 'COMMON.SETUP'
10013 include 'COMMON.NAMES'
10015 do i=1,max_template
10016 distancek(i)=9999999.9
10021 c Pseudo-energy and gradient from homology restraints (MODELLER-like
10023 C AL 5/2/14 - Introduce list of restraints
10024 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
10026 write(iout,*) "------- dist restrs start -------"
10028 do ii = link_start_homo,link_end_homo
10032 c write (iout,*) "dij(",i,j,") =",dij
10034 do k=1,constr_homology
10035 if(.not.l_homo(k,ii)) then
10039 distance(k)=odl(k,ii)-dij
10040 c write (iout,*) "distance(",k,") =",distance(k)
10042 c For Gaussian-type Urestr
10044 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
10045 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
10046 c write (iout,*) "distancek(",k,") =",distancek(k)
10047 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
10049 c For Lorentzian-type Urestr
10051 if (waga_dist.lt.0.0d0) then
10052 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
10053 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
10054 & (distance(k)**2+sigma_odlir(k,ii)**2))
10058 c min_odl=minval(distancek)
10059 do kk=1,constr_homology
10060 if(l_homo(kk,ii)) then
10061 min_odl=distancek(kk)
10065 do kk=1,constr_homology
10066 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
10067 & min_odl=distancek(kk)
10069 c write (iout,* )"min_odl",min_odl
10071 write (iout,*) "ij dij",i,j,dij
10072 write (iout,*) "distance",(distance(k),k=1,constr_homology)
10073 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
10074 write (iout,* )"min_odl",min_odl
10079 if (waga_dist.ge.0.0d0) then
10085 do k=1,constr_homology
10086 c Nie wiem po co to liczycie jeszcze raz!
10087 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
10088 c & (2*(sigma_odl(i,j,k))**2))
10089 if(.not.l_homo(k,ii)) cycle
10090 if (waga_dist.ge.0.0d0) then
10092 c For Gaussian-type Urestr
10094 godl(k)=dexp(-distancek(k)+min_odl)
10095 odleg2=odleg2+godl(k)
10097 c For Lorentzian-type Urestr
10100 odleg2=odleg2+distancek(k)
10103 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
10104 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
10105 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
10106 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
10109 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10110 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10112 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10113 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10115 if (waga_dist.ge.0.0d0) then
10117 c For Gaussian-type Urestr
10119 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
10121 c For Lorentzian-type Urestr
10124 odleg=odleg+odleg2/constr_homology
10128 c write (iout,*) "odleg",odleg ! sum of -ln-s
10131 c For Gaussian-type Urestr
10133 if (waga_dist.ge.0.0d0) sum_godl=odleg2
10135 do k=1,constr_homology
10136 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10137 c & *waga_dist)+min_odl
10138 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
10140 if(.not.l_homo(k,ii)) cycle
10141 if (waga_dist.ge.0.0d0) then
10142 c For Gaussian-type Urestr
10144 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
10146 c For Lorentzian-type Urestr
10149 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
10150 & sigma_odlir(k,ii)**2)**2)
10152 sum_sgodl=sum_sgodl+sgodl
10154 c sgodl2=sgodl2+sgodl
10155 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
10156 c write(iout,*) "constr_homology=",constr_homology
10157 c write(iout,*) i, j, k, "TEST K"
10159 if (waga_dist.ge.0.0d0) then
10161 c For Gaussian-type Urestr
10163 grad_odl3=waga_homology(iset)*waga_dist
10164 & *sum_sgodl/(sum_godl*dij)
10166 c For Lorentzian-type Urestr
10169 c Original grad expr modified by analogy w Gaussian-type Urestr grad
10170 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
10171 grad_odl3=-waga_homology(iset)*waga_dist*
10172 & sum_sgodl/(constr_homology*dij)
10175 c grad_odl3=sum_sgodl/(sum_godl*dij)
10178 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
10179 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
10180 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10182 ccc write(iout,*) godl, sgodl, grad_odl3
10184 c grad_odl=grad_odl+grad_odl3
10187 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
10188 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
10189 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
10190 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10191 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
10192 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
10193 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
10194 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10195 c if (i.eq.25.and.j.eq.27) then
10196 c write(iout,*) "jik",jik,"i",i,"j",j
10197 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
10198 c write(iout,*) "grad_odl3",grad_odl3
10199 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
10200 c write(iout,*) "ggodl",ggodl
10201 c write(iout,*) "ghpbc(",jik,i,")",
10202 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
10207 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
10208 ccc & dLOG(odleg2),"-odleg=", -odleg
10210 enddo ! ii-loop for dist
10212 write(iout,*) "------- dist restrs end -------"
10213 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
10214 c & waga_d.eq.1.0d0) call sum_gradient
10216 c Pseudo-energy and gradient from dihedral-angle restraints from
10217 c homology templates
10218 c write (iout,*) "End of distance loop"
10221 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
10223 write(iout,*) "------- dih restrs start -------"
10224 do i=idihconstr_start_homo,idihconstr_end_homo
10225 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
10228 do i=idihconstr_start_homo,idihconstr_end_homo
10230 c betai=beta(i,i+1,i+2,i+3)
10232 c write (iout,*) "betai =",betai
10233 do k=1,constr_homology
10234 dih_diff(k)=pinorm(dih(k,i)-betai)
10235 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
10236 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
10237 c & -(6.28318-dih_diff(i,k))
10238 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
10239 c & 6.28318+dih_diff(i,k)
10241 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
10243 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
10245 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
10248 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
10251 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
10252 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
10254 write (iout,*) "i",i," betai",betai," kat2",kat2
10255 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
10257 if (kat2.le.1.0d-14) cycle
10258 kat=kat-dLOG(kat2/constr_homology)
10259 c write (iout,*) "kat",kat ! sum of -ln-s
10261 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
10262 ccc & dLOG(kat2), "-kat=", -kat
10265 c ----------------------------------------------------------------------
10267 c ----------------------------------------------------------------------
10271 do k=1,constr_homology
10273 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
10275 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
10277 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
10278 sum_sgdih=sum_sgdih+sgdih
10280 c grad_dih3=sum_sgdih/sum_gdih
10281 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
10283 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
10284 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
10285 ccc & gloc(nphi+i-3,icg)
10286 gloc(i,icg)=gloc(i,icg)+grad_dih3
10287 c if (i.eq.25) then
10288 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
10290 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
10291 ccc & gloc(nphi+i-3,icg)
10293 enddo ! i-loop for dih
10295 write(iout,*) "------- dih restrs end -------"
10298 c Pseudo-energy and gradient for theta angle restraints from
10299 c homology templates
10300 c FP 01/15 - inserted from econstr_local_test.F, loop structure
10304 c For constr_homology reference structures (FP)
10306 c Uconst_back_tot=0.0d0
10309 c Econstr_back legacy
10312 c do i=ithet_start,ithet_end
10315 c do i=loc_start,loc_end
10317 duscdiff(j,i)=0.0d0
10318 duscdiffx(j,i)=0.0d0
10324 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
10325 c write (iout,*) "waga_theta",waga_theta
10326 if (waga_theta.gt.0.0d0) then
10328 write (iout,*) "usampl",usampl
10329 write(iout,*) "------- theta restrs start -------"
10330 c do i=ithet_start,ithet_end
10331 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
10334 c write (iout,*) "maxres",maxres,"nres",nres
10336 do i=ithet_start,ithet_end
10338 c do i=1,nfrag_back
10339 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10341 c Deviation of theta angles wrt constr_homology ref structures
10343 utheta_i=0.0d0 ! argument of Gaussian for single k
10344 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10345 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
10346 c over residues in a fragment
10347 c write (iout,*) "theta(",i,")=",theta(i)
10348 do k=1,constr_homology
10350 c dtheta_i=theta(j)-thetaref(j,iref)
10351 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
10352 theta_diff(k)=thetatpl(k,i)-theta(i)
10354 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
10355 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
10356 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
10357 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
10358 c Gradient for single Gaussian restraint in subr Econstr_back
10359 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10362 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
10363 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
10367 c Gradient for multiple Gaussian restraint
10368 sum_gtheta=gutheta_i
10370 do k=1,constr_homology
10371 c New generalized expr for multiple Gaussian from Econstr_back
10372 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
10374 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
10375 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
10378 c Final value of gradient using same var as in Econstr_back
10379 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
10380 & *waga_homology(iset)
10381 c dutheta(i)=sum_sgtheta/sum_gtheta
10383 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
10385 Eval=Eval-dLOG(gutheta_i/constr_homology)
10386 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
10387 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
10388 c Uconst_back=Uconst_back+utheta(i)
10389 enddo ! (i-loop for theta)
10391 write(iout,*) "------- theta restrs end -------"
10395 c Deviation of local SC geometry
10397 c Separation of two i-loops (instructed by AL - 11/3/2014)
10399 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
10400 c write (iout,*) "waga_d",waga_d
10403 write(iout,*) "------- SC restrs start -------"
10404 write (iout,*) "Initial duscdiff,duscdiffx"
10405 do i=loc_start,loc_end
10406 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
10407 & (duscdiffx(jik,i),jik=1,3)
10410 do i=loc_start,loc_end
10411 usc_diff_i=0.0d0 ! argument of Gaussian for single k
10412 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10413 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
10414 c write(iout,*) "xxtab, yytab, zztab"
10415 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
10416 do k=1,constr_homology
10418 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10419 c Original sign inverted for calc of gradients (s. Econstr_back)
10420 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10421 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10422 c write(iout,*) "dxx, dyy, dzz"
10423 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10425 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
10426 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
10427 c uscdiffk(k)=usc_diff(i)
10428 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
10429 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
10430 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10431 c & xxref(j),yyref(j),zzref(j)
10436 c Generalized expression for multiple Gaussian acc to that for a single
10437 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
10439 c Original implementation
10440 c sum_guscdiff=guscdiff(i)
10442 c sum_sguscdiff=0.0d0
10443 c do k=1,constr_homology
10444 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
10445 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
10446 c sum_sguscdiff=sum_sguscdiff+sguscdiff
10449 c Implementation of new expressions for gradient (Jan. 2015)
10451 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
10453 do k=1,constr_homology
10455 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
10456 c before. Now the drivatives should be correct
10458 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10459 c Original sign inverted for calc of gradients (s. Econstr_back)
10460 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10461 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10463 c New implementation
10465 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
10466 & sigma_d(k,i) ! for the grad wrt r'
10467 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
10470 c New implementation
10471 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
10473 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
10474 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
10475 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
10476 duscdiff(jik,i)=duscdiff(jik,i)+
10477 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
10478 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
10479 duscdiffx(jik,i)=duscdiffx(jik,i)+
10480 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
10481 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
10484 write(iout,*) "jik",jik,"i",i
10485 write(iout,*) "dxx, dyy, dzz"
10486 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10487 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
10488 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
10489 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
10490 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
10491 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
10492 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
10493 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
10494 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
10495 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
10496 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
10497 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
10498 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
10499 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
10500 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
10507 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
10508 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
10510 c write (iout,*) i," uscdiff",uscdiff(i)
10512 c Put together deviations from local geometry
10514 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
10515 c & wfrag_back(3,i,iset)*uscdiff(i)
10516 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
10517 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
10518 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
10519 c Uconst_back=Uconst_back+usc_diff(i)
10521 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
10523 c New implment: multiplied by sum_sguscdiff
10526 enddo ! (i-loop for dscdiff)
10531 write(iout,*) "------- SC restrs end -------"
10532 write (iout,*) "------ After SC loop in e_modeller ------"
10533 do i=loc_start,loc_end
10534 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
10535 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
10537 if (waga_theta.eq.1.0d0) then
10538 write (iout,*) "in e_modeller after SC restr end: dutheta"
10539 do i=ithet_start,ithet_end
10540 write (iout,*) i,dutheta(i)
10543 if (waga_d.eq.1.0d0) then
10544 write (iout,*) "e_modeller after SC loop: duscdiff/x"
10546 write (iout,*) i,(duscdiff(j,i),j=1,3)
10547 write (iout,*) i,(duscdiffx(j,i),j=1,3)
10552 c Total energy from homology restraints
10554 write (iout,*) "odleg",odleg," kat",kat
10555 write (iout,*) "odleg",odleg," kat",kat
10556 write (iout,*) "Eval",Eval," Erot",Erot
10557 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
10558 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
10559 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
10562 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
10564 c ehomology_constr=odleg+kat
10566 c For Lorentzian-type Urestr
10569 if (waga_dist.ge.0.0d0) then
10571 c For Gaussian-type Urestr
10573 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
10574 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10575 ehomology_constr=waga_dist*odleg+waga_angle*kat+
10576 & waga_theta*Eval+waga_d*Erot
10577 c write (iout,*) "ehomology_constr=",ehomology_constr
10580 c For Lorentzian-type Urestr
10582 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
10583 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10584 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
10585 & waga_theta*Eval+waga_d*Erot
10586 c write (iout,*) "ehomology_constr=",ehomology_constr
10589 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
10590 & "Eval",waga_theta,eval,
10591 & "Erot",waga_d,Erot
10592 write (iout,*) "ehomology_constr",ehomology_constr
10596 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
10597 747 format(a12,i4,i4,i4,f8.3,f8.3)
10598 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
10599 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
10600 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
10601 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)