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 if (wsccor.gt.0.0d0) then
130 call eback_sc_corr(esccor)
135 if (wliptran.gt.0) then
136 call Eliptransfer(eliptran)
142 C 12/1/95 Multi-body terms
146 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
147 & .or. wturn6.gt.0.0d0) then
148 c write(iout,*)"calling multibody_eello"
149 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
150 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
151 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
158 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
159 c write (iout,*) "Calling multibody_hbond"
160 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
163 c write (iout,*) "NSAXS",nsaxs
164 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
165 call e_saxs(Esaxs_constr)
166 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
167 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
168 call e_saxsC(Esaxs_constr)
169 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
173 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
174 if (constr_homology.ge.1) then
175 call e_modeller(ehomology_constr)
177 ehomology_constr=0.0d0
180 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
182 C BARTEK for dfa test!
183 if (wdfa_dist.gt.0) call edfad(edfadis)
184 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
185 if (wdfa_tor.gt.0) call edfat(edfator)
186 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
187 if (wdfa_nei.gt.0) call edfan(edfanei)
188 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
189 if (wdfa_beta.gt.0) call edfab(edfabet)
190 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
194 if (shield_mode.gt.0) then
195 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
197 & +fact(1)*wvdwpp*evdw1
198 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
200 & +wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
201 & +wcorr6*fact(5)*ecorr6
202 & +wturn4*fact(3)*eello_turn4
203 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
204 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
205 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
206 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
207 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
210 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
212 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
213 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
214 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
215 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
216 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
217 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
218 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
219 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
223 if (shield_mode.gt.0) then
224 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
225 & +welec*fact(1)*(ees+evdw1)
226 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
227 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
228 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
229 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
230 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
231 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
232 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
233 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
236 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
237 & +welec*fact(1)*(ees+evdw1)
238 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
239 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
240 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
241 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
242 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
243 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
244 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
245 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
252 energia(2)=evdw2-evdw2_14
269 energia(8)=eello_turn3
270 energia(9)=eello_turn4
279 energia(20)=edihcnstr
282 energia(24)=ethetacnstr
283 energia(26)=esaxs_constr
284 energia(27)=ehomology_constr
292 if (isnan(etot).ne.0) energia(0)=1.0d+99
294 if (isnan(etot)) energia(0)=1.0d+99
299 idumm=proc_proc(etot,i)
301 call proc_proc(etot,i)
303 if(i.eq.1)energia(0)=1.0d+99
309 call enerprint(energia,fact)
313 C Sum up the components of the Cartesian gradient.
318 if (shield_mode.eq.0) then
319 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
320 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
322 & wstrain*ghpbc(j,i)+
323 & wcorr*fact(3)*gradcorr(j,i)+
324 & wel_loc*fact(2)*gel_loc(j,i)+
325 & wturn3*fact(2)*gcorr3_turn(j,i)+
326 & wturn4*fact(3)*gcorr4_turn(j,i)+
327 & wcorr5*fact(4)*gradcorr5(j,i)+
328 & wcorr6*fact(5)*gradcorr6(j,i)+
329 & wturn6*fact(5)*gcorr6_turn(j,i)+
330 & wsccor*fact(2)*gsccorc(j,i)
331 & +wliptran*gliptranc(j,i)+
332 & wdfa_dist*gdfad(j,i)+
333 & wdfa_tor*gdfat(j,i)+
334 & wdfa_nei*gdfan(j,i)+
335 & wdfa_beta*gdfab(j,i)
336 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
338 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
339 & wsccor*fact(2)*gsccorx(j,i)
340 & +wliptran*gliptranx(j,i)
342 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
343 & +fact(1)*wscp*gvdwc_scp(j,i)+
344 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
346 & wstrain*ghpbc(j,i)+
347 & wcorr*fact(3)*gradcorr(j,i)+
348 & wel_loc*fact(2)*gel_loc(j,i)+
349 & wturn3*fact(2)*gcorr3_turn(j,i)+
350 & wturn4*fact(3)*gcorr4_turn(j,i)+
351 & wcorr5*fact(4)*gradcorr5(j,i)+
352 & wcorr6*fact(5)*gradcorr6(j,i)+
353 & wturn6*fact(5)*gcorr6_turn(j,i)+
354 & wsccor*fact(2)*gsccorc(j,i)
355 & +wliptran*gliptranc(j,i)
356 & +welec*gshieldc(j,i)
357 & +welec*gshieldc_loc(j,i)
358 & +wcorr*gshieldc_ec(j,i)
359 & +wcorr*gshieldc_loc_ec(j,i)
360 & +wturn3*gshieldc_t3(j,i)
361 & +wturn3*gshieldc_loc_t3(j,i)
362 & +wturn4*gshieldc_t4(j,i)
363 & +wturn4*gshieldc_loc_t4(j,i)
364 & +wel_loc*gshieldc_ll(j,i)
365 & +wel_loc*gshieldc_loc_ll(j,i)+
366 & wdfa_dist*gdfad(j,i)+
367 & wdfa_tor*gdfat(j,i)+
368 & wdfa_nei*gdfan(j,i)+
369 & wdfa_beta*gdfab(j,i)
370 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
371 & +fact(1)*wscp*gradx_scp(j,i)+
373 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
374 & wsccor*fact(2)*gsccorx(j,i)
375 & +wliptran*gliptranx(j,i)
376 & +welec*gshieldx(j,i)
377 & +wcorr*gshieldx_ec(j,i)
378 & +wturn3*gshieldx_t3(j,i)
379 & +wturn4*gshieldx_t4(j,i)
380 & +wel_loc*gshieldx_ll(j,i)
388 if (shield_mode.eq.0) then
389 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
390 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
392 & wcorr*fact(3)*gradcorr(j,i)+
393 & wel_loc*fact(2)*gel_loc(j,i)+
394 & wturn3*fact(2)*gcorr3_turn(j,i)+
395 & wturn4*fact(3)*gcorr4_turn(j,i)+
396 & wcorr5*fact(4)*gradcorr5(j,i)+
397 & wcorr6*fact(5)*gradcorr6(j,i)+
398 & wturn6*fact(5)*gcorr6_turn(j,i)+
399 & wsccor*fact(2)*gsccorc(j,i)
400 & +wliptran*gliptranc(j,i)+
401 & wdfa_dist*gdfad(j,i)+
402 & wdfa_tor*gdfat(j,i)+
403 & wdfa_nei*gdfan(j,i)+
404 & wdfa_beta*gdfab(j,i)
405 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
407 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
408 & wsccor*fact(1)*gsccorx(j,i)
409 & +wliptran*gliptranx(j,i)
411 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
412 & fact(1)*wscp*gvdwc_scp(j,i)+
413 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
415 & wcorr*fact(3)*gradcorr(j,i)+
416 & wel_loc*fact(2)*gel_loc(j,i)+
417 & wturn3*fact(2)*gcorr3_turn(j,i)+
418 & wturn4*fact(3)*gcorr4_turn(j,i)+
419 & wcorr5*fact(4)*gradcorr5(j,i)+
420 & wcorr6*fact(5)*gradcorr6(j,i)+
421 & wturn6*fact(5)*gcorr6_turn(j,i)+
422 & wsccor*fact(2)*gsccorc(j,i)
423 & +wliptran*gliptranc(j,i)
424 & +welec*gshieldc(j,i)
425 & +welec*gshieldc_loc(j,i)
426 & +wcorr*gshieldc_ec(j,i)
427 & +wcorr*gshieldc_loc_ec(j,i)
428 & +wturn3*gshieldc_t3(j,i)
429 & +wturn3*gshieldc_loc_t3(j,i)
430 & +wturn4*gshieldc_t4(j,i)
431 & +wturn4*gshieldc_loc_t4(j,i)
432 & +wel_loc*gshieldc_ll(j,i)
433 & +wel_loc*gshieldc_loc_ll(j,i)+
434 & wdfa_dist*gdfad(j,i)+
435 & wdfa_tor*gdfat(j,i)+
436 & wdfa_nei*gdfan(j,i)+
437 & wdfa_beta*gdfab(j,i)
438 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
439 & fact(1)*wscp*gradx_scp(j,i)+
441 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
442 & wsccor*fact(1)*gsccorx(j,i)
443 & +wliptran*gliptranx(j,i)
444 & +welec*gshieldx(j,i)
445 & +wcorr*gshieldx_ec(j,i)
446 & +wturn3*gshieldx_t3(j,i)
447 & +wturn4*gshieldx_t4(j,i)
448 & +wel_loc*gshieldx_ll(j,i)
456 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
457 & +wcorr5*fact(4)*g_corr5_loc(i)
458 & +wcorr6*fact(5)*g_corr6_loc(i)
459 & +wturn4*fact(3)*gel_loc_turn4(i)
460 & +wturn3*fact(2)*gel_loc_turn3(i)
461 & +wturn6*fact(5)*gel_loc_turn6(i)
462 & +wel_loc*fact(2)*gel_loc_loc(i)
463 c & +wsccor*fact(1)*gsccor_loc(i)
464 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
467 if (dyn_ss) call dyn_set_nss
470 C------------------------------------------------------------------------
471 subroutine enerprint(energia,fact)
472 implicit real*8 (a-h,o-z)
474 include 'COMMON.IOUNITS'
475 include 'COMMON.FFIELD'
476 include 'COMMON.SBRIDGE'
477 include 'COMMON.CONTROL'
478 double precision energia(0:max_ene),fact(6)
480 evdw=energia(1)+fact(6)*energia(21)
482 evdw2=energia(2)+energia(17)
494 eello_turn3=energia(8)
495 eello_turn4=energia(9)
496 eello_turn6=energia(10)
503 edihcnstr=energia(20)
505 ethetacnstr=energia(24)
508 ehomology_constr=energia(27)
510 edfadis = energia(28)
511 edfator = energia(29)
512 edfanei = energia(30)
513 edfabet = energia(31)
515 write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
516 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
517 & etors_d,wtor_d*fact(2),ehpb,wstrain,
519 & ecorr,wcorr*fact(3),
520 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
523 & wel_loc*fact(2),eello_turn3,wturn3*fact(2),
524 & eello_turn4,wturn4*fact(3),
526 & eello_turn6,wturn6*fact(5),
528 & esccor,wsccor*fact(1),edihcnstr,
529 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
530 & etube,wtube,esaxs,wsaxs,ehomology_constr,
531 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
534 10 format (/'Virtual-chain energies:'//
535 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
536 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
537 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
538 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
539 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
540 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
541 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
542 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
543 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
544 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
545 & ' (SS bridges & dist. cnstr.)'/
547 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
548 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
549 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
551 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
552 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
553 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
555 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
557 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
558 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
559 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
560 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
561 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
562 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
563 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
564 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
565 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
566 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
567 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
568 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
569 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
570 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
571 & 'ETOT= ',1pE16.6,' (total)')
574 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
575 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
576 & etors_d,wtor_d*fact(2),ehpb,
578 & wstrain,ecorr,wcorr*fact(3),
579 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
581 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
582 & eello_turn4,wturn4*fact(3),
584 & eello_turn6,wturn6*fact(5),
586 & esccor,wsccor*fact(1),edihcnstr,
587 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
588 & etube,wtube,esaxs,wsaxs,ehomology_constr,
589 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
592 10 format (/'Virtual-chain energies:'//
593 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
594 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
595 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
596 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
597 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
598 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
599 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
600 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
601 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
602 & ' (SS bridges & dist. restr.)'/
604 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
605 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
606 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
608 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
609 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
610 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
612 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
614 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
615 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
616 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
617 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
618 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
619 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
620 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
621 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
622 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
623 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
624 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
625 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
626 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
627 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
628 & 'ETOT= ',1pE16.6,' (total)')
632 C-----------------------------------------------------------------------
633 subroutine elj(evdw,evdw_t)
635 C This subroutine calculates the interaction energy of nonbonded side chains
636 C assuming the LJ potential of interaction.
638 implicit real*8 (a-h,o-z)
640 include "DIMENSIONS.COMPAR"
641 parameter (accur=1.0d-10)
644 include 'COMMON.LOCAL'
645 include 'COMMON.CHAIN'
646 include 'COMMON.DERIV'
647 include 'COMMON.INTERACT'
648 include 'COMMON.TORSION'
649 include 'COMMON.SBRIDGE'
650 include 'COMMON.NAMES'
651 include 'COMMON.IOUNITS'
653 include 'COMMON.CONTACTS'
654 include 'COMMON.CONTMAT'
659 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
663 c eneps_temp(j,i)=0.0d0
672 if (itypi.eq.ntyp1) cycle
673 itypi1=iabs(itype(i+1))
680 C Calculate SC interaction energy.
683 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
684 cd & 'iend=',iend(i,iint)
685 do j=istart(i,iint),iend(i,iint)
687 if (itypj.eq.ntyp1) cycle
691 C Change 12/1/95 to calculate four-body interactions
692 rij=xj*xj+yj*yj+zj*zj
696 if (sss1.eq.0.0d0) cycle
697 sssgrad1=sscagrad(sqrij)
698 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
699 eps0ij=eps(itypi,itypj)
704 ij=icant(itypi,itypj)
706 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
707 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
710 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
711 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
712 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
713 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
714 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
715 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
716 if (bb.gt.0.0d0) then
717 evdw=evdw+sss1*evdwij
719 evdw_t=evdw_t+sss1*evdwij
723 C Calculate the components of the gradient in DC and X
725 fac=-rrij*(e1+evdwij)*sss1
726 & +evdwij*sssgrad1/sqrij/expon
731 gvdwx(k,i)=gvdwx(k,i)-gg(k)
732 gvdwx(k,j)=gvdwx(k,j)+gg(k)
736 gvdwc(l,k)=gvdwc(l,k)+gg(l)
742 C 12/1/95, revised on 5/20/97
744 C Calculate the contact function. The ith column of the array JCONT will
745 C contain the numbers of atoms that make contacts with the atom I (of numbers
746 C greater than I). The arrays FACONT and GACONT will contain the values of
747 C the contact function and its derivative.
749 C Uncomment next line, if the correlation interactions include EVDW explicitly.
750 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
751 C Uncomment next line, if the correlation interactions are contact function only
752 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
754 sigij=sigma(itypi,itypj)
755 r0ij=rs0(itypi,itypj)
757 C Check whether the SC's are not too far to make a contact.
760 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
761 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
763 if (fcont.gt.0.0D0) then
764 C If the SC-SC distance if close to sigma, apply spline.
765 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
766 cAdam & fcont1,fprimcont1)
767 cAdam fcont1=1.0d0-fcont1
768 cAdam if (fcont1.gt.0.0d0) then
769 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
770 cAdam fcont=fcont*fcont1
772 C Uncomment following 4 lines to have the geometric average of the epsilon0's
773 cga eps0ij=1.0d0/dsqrt(eps0ij)
775 cga gg(k)=gg(k)*eps0ij
777 cga eps0ij=-evdwij*eps0ij
778 C Uncomment for AL's type of SC correlation interactions.
780 num_conti=num_conti+1
782 facont(num_conti,i)=fcont*eps0ij
783 fprimcont=eps0ij*fprimcont/rij
785 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
786 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
787 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
788 C Uncomment following 3 lines for Skolnick's type of SC correlation.
789 gacont(1,num_conti,i)=-fprimcont*xj
790 gacont(2,num_conti,i)=-fprimcont*yj
791 gacont(3,num_conti,i)=-fprimcont*zj
792 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
793 cd write (iout,'(2i3,3f10.5)')
794 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
802 num_cont(i)=num_conti
808 gvdwc(j,i)=expon*gvdwc(j,i)
809 gvdwx(j,i)=expon*gvdwx(j,i)
813 C******************************************************************************
817 C To save time, the factor of EXPON has been extracted from ALL components
818 C of GVDWC and GRADX. Remember to multiply them by this factor before further
821 C******************************************************************************
824 C-----------------------------------------------------------------------------
825 subroutine eljk(evdw,evdw_t)
827 C This subroutine calculates the interaction energy of nonbonded side chains
828 C assuming the LJK potential of interaction.
830 implicit real*8 (a-h,o-z)
832 include "DIMENSIONS.COMPAR"
835 include 'COMMON.LOCAL'
836 include 'COMMON.CHAIN'
837 include 'COMMON.DERIV'
838 include 'COMMON.INTERACT'
839 include 'COMMON.IOUNITS'
840 include 'COMMON.NAMES'
845 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
848 c eneps_temp(j,i)=0.0d0
855 if (itypi.eq.ntyp1) cycle
856 itypi1=iabs(itype(i+1))
861 C Calculate SC interaction energy.
864 do j=istart(i,iint),iend(i,iint)
866 if (itypj.eq.ntyp1) cycle
870 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
872 e_augm=augm(itypi,itypj)*fac_augm
876 if (sss1.eq.0.0d0) cycle
877 sssgrad1=sscagrad(rij)
878 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
879 fac=r_shift_inv**expon
883 ij=icant(itypi,itypj)
884 c eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
885 c & /dabs(eps(itypi,itypj))
886 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
887 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
888 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
889 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
890 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
891 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
892 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
893 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
894 if (bb.gt.0.0d0) then
895 evdw=evdw+evdwij*sss1
897 evdw_t=evdw_t+evdwij*sss1
901 C Calculate the components of the gradient in DC and X
903 fac=(-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2))*sss1
904 & +evdwij*sssgrad1*r_inv_ij/expon
909 gvdwx(k,i)=gvdwx(k,i)-gg(k)
910 gvdwx(k,j)=gvdwx(k,j)+gg(k)
914 gvdwc(l,k)=gvdwc(l,k)+gg(l)
924 gvdwc(j,i)=expon*gvdwc(j,i)
925 gvdwx(j,i)=expon*gvdwx(j,i)
931 C-----------------------------------------------------------------------------
932 subroutine ebp(evdw,evdw_t)
934 C This subroutine calculates the interaction energy of nonbonded side chains
935 C assuming the Berne-Pechukas potential of interaction.
937 implicit real*8 (a-h,o-z)
939 include "DIMENSIONS.COMPAR"
942 include 'COMMON.LOCAL'
943 include 'COMMON.CHAIN'
944 include 'COMMON.DERIV'
945 include 'COMMON.NAMES'
946 include 'COMMON.INTERACT'
947 include 'COMMON.IOUNITS'
948 include 'COMMON.CALC'
950 c double precision rrsave(maxdim)
956 c eneps_temp(j,i)=0.0d0
961 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
962 c if (icall.eq.0) then
970 if (itypi.eq.ntyp1) cycle
971 itypi1=iabs(itype(i+1))
975 dxi=dc_norm(1,nres+i)
976 dyi=dc_norm(2,nres+i)
977 dzi=dc_norm(3,nres+i)
978 dsci_inv=vbld_inv(i+nres)
980 C Calculate SC interaction energy.
983 do j=istart(i,iint),iend(i,iint)
986 if (itypj.eq.ntyp1) cycle
987 dscj_inv=vbld_inv(j+nres)
988 chi1=chi(itypi,itypj)
989 chi2=chi(itypj,itypi)
996 alf12=0.5D0*(alf1+alf2)
997 C For diagnostics only!!!
1010 dxj=dc_norm(1,nres+j)
1011 dyj=dc_norm(2,nres+j)
1012 dzj=dc_norm(3,nres+j)
1013 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1014 cd if (icall.eq.0) then
1020 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1022 C Calculate whole angle-dependent part of epsilon and contributions
1023 C to its derivatives
1024 fac=(rrij*sigsq)**expon2
1027 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1028 eps2der=evdwij*eps3rt
1029 eps3der=evdwij*eps2rt
1030 evdwij=evdwij*eps2rt*eps3rt
1031 ij=icant(itypi,itypj)
1032 aux=eps1*eps2rt**2*eps3rt**2
1033 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
1034 c & /dabs(eps(itypi,itypj))
1035 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
1036 if (bb.gt.0.0d0) then
1039 evdw_t=evdw_t+evdwij
1043 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1045 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1046 & restyp(itypi),i,restyp(itypj),j,
1047 & epsi,sigm,chi1,chi2,chip1,chip2,
1048 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1049 & om1,om2,om12,1.0D0/dsqrt(rrij),
1052 C Calculate gradient components.
1053 e1=e1*eps1*eps2rt**2*eps3rt**2
1054 fac=-expon*(e1+evdwij)
1057 C Calculate radial part of the gradient
1061 C Calculate the angular part of the gradient and sum add the contributions
1062 C to the appropriate components of the Cartesian gradient.
1071 C-----------------------------------------------------------------------------
1072 subroutine egb(evdw,evdw_t)
1074 C This subroutine calculates the interaction energy of nonbonded side chains
1075 C assuming the Gay-Berne potential of interaction.
1077 implicit real*8 (a-h,o-z)
1078 include 'DIMENSIONS'
1079 include "DIMENSIONS.COMPAR"
1080 include 'COMMON.GEO'
1081 include 'COMMON.VAR'
1082 include 'COMMON.LOCAL'
1083 include 'COMMON.CHAIN'
1084 include 'COMMON.DERIV'
1085 include 'COMMON.NAMES'
1086 include 'COMMON.INTERACT'
1087 include 'COMMON.IOUNITS'
1088 include 'COMMON.CALC'
1089 include 'COMMON.SBRIDGE'
1092 integer icant,xshift,yshift,zshift
1096 c eneps_temp(j,i)=0.0d0
1099 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1103 c if (icall.gt.0) lprn=.true.
1105 do i=iatsc_s,iatsc_e
1106 itypi=iabs(itype(i))
1107 if (itypi.eq.ntyp1) cycle
1108 itypi1=iabs(itype(i+1))
1112 C returning the ith atom to box
1114 if (xi.lt.0) xi=xi+boxxsize
1116 if (yi.lt.0) yi=yi+boxysize
1118 if (zi.lt.0) zi=zi+boxzsize
1119 if ((zi.gt.bordlipbot)
1120 &.and.(zi.lt.bordliptop)) then
1121 C the energy transfer exist
1122 if (zi.lt.buflipbot) then
1123 C what fraction I am in
1125 & ((zi-bordlipbot)/lipbufthick)
1126 C lipbufthick is thickenes of lipid buffore
1127 sslipi=sscalelip(fracinbuf)
1128 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1129 elseif (zi.gt.bufliptop) then
1130 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1131 sslipi=sscalelip(fracinbuf)
1132 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1142 dxi=dc_norm(1,nres+i)
1143 dyi=dc_norm(2,nres+i)
1144 dzi=dc_norm(3,nres+i)
1145 dsci_inv=vbld_inv(i+nres)
1147 C Calculate SC interaction energy.
1149 do iint=1,nint_gr(i)
1150 do j=istart(i,iint),iend(i,iint)
1151 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1152 call dyn_ssbond_ene(i,j,evdwij)
1154 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1155 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1156 C triple bond artifac removal
1157 do k=j+1,iend(i,iint)
1158 C search over all next residues
1159 if (dyn_ss_mask(k)) then
1160 C check if they are cysteins
1161 C write(iout,*) 'k=',k
1162 call triple_ssbond_ene(i,j,k,evdwij)
1163 C call the energy function that removes the artifical triple disulfide
1164 C bond the soubroutine is located in ssMD.F
1166 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1167 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1168 endif!dyn_ss_mask(k)
1172 itypj=iabs(itype(j))
1173 if (itypj.eq.ntyp1) cycle
1174 dscj_inv=vbld_inv(j+nres)
1175 sig0ij=sigma(itypi,itypj)
1176 chi1=chi(itypi,itypj)
1177 chi2=chi(itypj,itypi)
1184 alf12=0.5D0*(alf1+alf2)
1185 C For diagnostics only!!!
1198 C returning jth atom to box
1200 if (xj.lt.0) xj=xj+boxxsize
1202 if (yj.lt.0) yj=yj+boxysize
1204 if (zj.lt.0) zj=zj+boxzsize
1205 if ((zj.gt.bordlipbot)
1206 &.and.(zj.lt.bordliptop)) then
1207 C the energy transfer exist
1208 if (zj.lt.buflipbot) then
1209 C what fraction I am in
1211 & ((zj-bordlipbot)/lipbufthick)
1212 C lipbufthick is thickenes of lipid buffore
1213 sslipj=sscalelip(fracinbuf)
1214 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1215 elseif (zj.gt.bufliptop) then
1216 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1217 sslipj=sscalelip(fracinbuf)
1218 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1227 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1228 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1229 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1230 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1231 C if (aa.ne.aa_aq(itypi,itypj)) then
1233 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1234 C & bb_aq(itypi,itypj)-bb,
1238 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1239 C checking the distance
1240 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1245 C finding the closest
1249 xj=xj_safe+xshift*boxxsize
1250 yj=yj_safe+yshift*boxysize
1251 zj=zj_safe+zshift*boxzsize
1252 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1253 if(dist_temp.lt.dist_init) then
1263 if (subchap.eq.1) then
1273 dxj=dc_norm(1,nres+j)
1274 dyj=dc_norm(2,nres+j)
1275 dzj=dc_norm(3,nres+j)
1276 c write (iout,*) i,j,xj,yj,zj
1277 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1279 sss=sscale(1.0d0/rij)
1280 sssgrad=sscagrad(1.0d0/rij)
1281 if (sss.le.0.0) cycle
1282 C Calculate angle-dependent terms of energy and contributions to their
1287 sig=sig0ij*dsqrt(sigsq)
1288 rij_shift=1.0D0/rij-sig+sig0ij
1289 C I hate to put IF's in the loops, but here don't have another choice!!!!
1290 if (rij_shift.le.0.0D0) then
1295 c---------------------------------------------------------------
1296 rij_shift=1.0D0/rij_shift
1297 fac=rij_shift**expon
1300 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1301 eps2der=evdwij*eps3rt
1302 eps3der=evdwij*eps2rt
1303 evdwij=evdwij*eps2rt*eps3rt
1305 evdw=evdw+evdwij*sss
1307 evdw_t=evdw_t+evdwij*sss
1309 ij=icant(itypi,itypj)
1310 aux=eps1*eps2rt**2*eps3rt**2
1311 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1312 c & /dabs(eps(itypi,itypj))
1313 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1314 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1315 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1316 c & aux*e2/eps(itypi,itypj)
1318 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1322 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1323 & restyp(itypi),i,restyp(itypj),j,
1324 & epsi,sigm,chi1,chi2,chip1,chip2,
1325 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1326 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1328 write (iout,*) "partial sum", evdw, evdw_t
1333 C Calculate gradient components.
1334 e1=e1*eps1*eps2rt**2*eps3rt**2
1335 fac=-expon*(e1+evdwij)*rij_shift
1338 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1339 C Calculate the radial part of the gradient
1343 C Calculate angular part of the gradient.
1346 C write(iout,*) "partial sum", evdw, evdw_t
1353 C-----------------------------------------------------------------------------
1354 subroutine egbv(evdw,evdw_t)
1356 C This subroutine calculates the interaction energy of nonbonded side chains
1357 C assuming the Gay-Berne-Vorobjev potential of interaction.
1359 implicit real*8 (a-h,o-z)
1360 include 'DIMENSIONS'
1361 include "DIMENSIONS.COMPAR"
1362 include 'COMMON.GEO'
1363 include 'COMMON.VAR'
1364 include 'COMMON.LOCAL'
1365 include 'COMMON.CHAIN'
1366 include 'COMMON.DERIV'
1367 include 'COMMON.NAMES'
1368 include 'COMMON.INTERACT'
1369 include 'COMMON.IOUNITS'
1370 include 'COMMON.CALC'
1371 common /srutu/ icall
1377 c eneps_temp(j,i)=0.0d0
1382 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1385 c if (icall.gt.0) lprn=.true.
1387 do i=iatsc_s,iatsc_e
1388 itypi=iabs(itype(i))
1389 if (itypi.eq.ntyp1) cycle
1390 itypi1=iabs(itype(i+1))
1394 dxi=dc_norm(1,nres+i)
1395 dyi=dc_norm(2,nres+i)
1396 dzi=dc_norm(3,nres+i)
1397 dsci_inv=vbld_inv(i+nres)
1399 C Calculate SC interaction energy.
1401 do iint=1,nint_gr(i)
1402 do j=istart(i,iint),iend(i,iint)
1404 itypj=iabs(itype(j))
1405 if (itypj.eq.ntyp1) cycle
1406 dscj_inv=vbld_inv(j+nres)
1407 sig0ij=sigma(itypi,itypj)
1408 r0ij=r0(itypi,itypj)
1409 chi1=chi(itypi,itypj)
1410 chi2=chi(itypj,itypi)
1417 alf12=0.5D0*(alf1+alf2)
1418 C For diagnostics only!!!
1431 dxj=dc_norm(1,nres+j)
1432 dyj=dc_norm(2,nres+j)
1433 dzj=dc_norm(3,nres+j)
1434 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1436 sss=sscale(1.0d0/rij)
1437 if (sss.eq.0.0d0) cycle
1438 sssgrad=sscagrad(1.0d0/rij)
1439 C Calculate angle-dependent terms of energy and contributions to their
1443 sig=sig0ij*dsqrt(sigsq)
1444 rij_shift=1.0D0/rij-sig+r0ij
1445 C I hate to put IF's in the loops, but here don't have another choice!!!!
1446 if (rij_shift.le.0.0D0) then
1451 c---------------------------------------------------------------
1452 rij_shift=1.0D0/rij_shift
1453 fac=rij_shift**expon
1456 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1457 eps2der=evdwij*eps3rt
1458 eps3der=evdwij*eps2rt
1459 fac_augm=rrij**expon
1460 e_augm=augm(itypi,itypj)*fac_augm
1461 evdwij=evdwij*eps2rt*eps3rt
1462 if (bb.gt.0.0d0) then
1463 evdw=evdw+(evdwij+e_augm)*sss
1465 evdw_t=evdw_t+(evdwij+e_augm)*sss
1467 ij=icant(itypi,itypj)
1468 aux=eps1*eps2rt**2*eps3rt**2
1469 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1470 c & /dabs(eps(itypi,itypj))
1471 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1472 c eneps_temp(ij)=eneps_temp(ij)
1473 c & +(evdwij+e_augm)/eps(itypi,itypj)
1475 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1476 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1477 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1478 c & restyp(itypi),i,restyp(itypj),j,
1479 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1480 c & chi1,chi2,chip1,chip2,
1481 c & eps1,eps2rt**2,eps3rt**2,
1482 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1486 C Calculate gradient components.
1487 e1=e1*eps1*eps2rt**2*eps3rt**2
1488 fac=-expon*(e1+evdwij)*rij_shift
1490 fac=rij*fac-2*expon*rrij*e_augm
1491 fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
1492 C Calculate the radial part of the gradient
1496 C Calculate angular part of the gradient.
1504 C-----------------------------------------------------------------------------
1505 subroutine sc_angular
1506 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1507 C om12. Called by ebp, egb, and egbv.
1509 include 'COMMON.CALC'
1513 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1514 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1515 om12=dxi*dxj+dyi*dyj+dzi*dzj
1517 C Calculate eps1(om12) and its derivative in om12
1518 faceps1=1.0D0-om12*chiom12
1519 faceps1_inv=1.0D0/faceps1
1520 eps1=dsqrt(faceps1_inv)
1521 C Following variable is eps1*deps1/dom12
1522 eps1_om12=faceps1_inv*chiom12
1523 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1528 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1529 sigsq=1.0D0-facsig*faceps1_inv
1530 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1531 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1532 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1533 C Calculate eps2 and its derivatives in om1, om2, and om12.
1536 chipom12=chip12*om12
1537 facp=1.0D0-om12*chipom12
1539 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1540 C Following variable is the square root of eps2
1541 eps2rt=1.0D0-facp1*facp_inv
1542 C Following three variables are the derivatives of the square root of eps
1543 C in om1, om2, and om12.
1544 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1545 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1546 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1547 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1548 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1549 C Calculate whole angle-dependent part of epsilon and contributions
1550 C to its derivatives
1553 C----------------------------------------------------------------------------
1555 implicit real*8 (a-h,o-z)
1556 include 'DIMENSIONS'
1557 include 'COMMON.CHAIN'
1558 include 'COMMON.DERIV'
1559 include 'COMMON.CALC'
1560 double precision dcosom1(3),dcosom2(3)
1561 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1562 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1563 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1564 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1566 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1567 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1570 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1573 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1574 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1575 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1576 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1577 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1578 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1581 C Calculate the components of the gradient in DC and X
1585 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1590 c------------------------------------------------------------------------------
1591 subroutine vec_and_deriv
1592 implicit real*8 (a-h,o-z)
1593 include 'DIMENSIONS'
1594 include 'COMMON.IOUNITS'
1595 include 'COMMON.GEO'
1596 include 'COMMON.VAR'
1597 include 'COMMON.LOCAL'
1598 include 'COMMON.CHAIN'
1599 include 'COMMON.VECTORS'
1600 include 'COMMON.DERIV'
1601 include 'COMMON.INTERACT'
1602 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1603 C Compute the local reference systems. For reference system (i), the
1604 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1605 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1607 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1608 if (i.eq.nres-1) then
1609 C Case of the last full residue
1610 C Compute the Z-axis
1611 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1612 costh=dcos(pi-theta(nres))
1613 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1614 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1620 C Compute the derivatives of uz
1622 uzder(2,1,1)=-dc_norm(3,i-1)
1623 uzder(3,1,1)= dc_norm(2,i-1)
1624 uzder(1,2,1)= dc_norm(3,i-1)
1626 uzder(3,2,1)=-dc_norm(1,i-1)
1627 uzder(1,3,1)=-dc_norm(2,i-1)
1628 uzder(2,3,1)= dc_norm(1,i-1)
1631 uzder(2,1,2)= dc_norm(3,i)
1632 uzder(3,1,2)=-dc_norm(2,i)
1633 uzder(1,2,2)=-dc_norm(3,i)
1635 uzder(3,2,2)= dc_norm(1,i)
1636 uzder(1,3,2)= dc_norm(2,i)
1637 uzder(2,3,2)=-dc_norm(1,i)
1640 C Compute the Y-axis
1643 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1646 C Compute the derivatives of uy
1649 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1650 & -dc_norm(k,i)*dc_norm(j,i-1)
1651 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1653 uyder(j,j,1)=uyder(j,j,1)-costh
1654 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1659 uygrad(l,k,j,i)=uyder(l,k,j)
1660 uzgrad(l,k,j,i)=uzder(l,k,j)
1664 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1665 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1666 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1667 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1671 C Compute the Z-axis
1672 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1673 costh=dcos(pi-theta(i+2))
1674 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1679 C Compute the derivatives of uz
1681 uzder(2,1,1)=-dc_norm(3,i+1)
1682 uzder(3,1,1)= dc_norm(2,i+1)
1683 uzder(1,2,1)= dc_norm(3,i+1)
1685 uzder(3,2,1)=-dc_norm(1,i+1)
1686 uzder(1,3,1)=-dc_norm(2,i+1)
1687 uzder(2,3,1)= dc_norm(1,i+1)
1690 uzder(2,1,2)= dc_norm(3,i)
1691 uzder(3,1,2)=-dc_norm(2,i)
1692 uzder(1,2,2)=-dc_norm(3,i)
1694 uzder(3,2,2)= dc_norm(1,i)
1695 uzder(1,3,2)= dc_norm(2,i)
1696 uzder(2,3,2)=-dc_norm(1,i)
1699 C Compute the Y-axis
1702 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1705 C Compute the derivatives of uy
1708 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1709 & -dc_norm(k,i)*dc_norm(j,i+1)
1710 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1712 uyder(j,j,1)=uyder(j,j,1)-costh
1713 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1718 uygrad(l,k,j,i)=uyder(l,k,j)
1719 uzgrad(l,k,j,i)=uzder(l,k,j)
1723 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1724 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1725 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1726 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1732 vbld_inv_temp(1)=vbld_inv(i+1)
1733 if (i.lt.nres-1) then
1734 vbld_inv_temp(2)=vbld_inv(i+2)
1736 vbld_inv_temp(2)=vbld_inv(i)
1741 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1742 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1750 C--------------------------------------------------------------------------
1751 subroutine set_matrices
1752 implicit real*8 (a-h,o-z)
1753 include 'DIMENSIONS'
1757 integer status(MPI_STATUS_SIZE)
1759 include 'COMMON.IOUNITS'
1760 include 'COMMON.GEO'
1761 include 'COMMON.VAR'
1762 include 'COMMON.LOCAL'
1763 include 'COMMON.CHAIN'
1764 include 'COMMON.DERIV'
1765 include 'COMMON.INTERACT'
1766 include 'COMMON.CONTACTS'
1767 include 'COMMON.TORSION'
1768 include 'COMMON.VECTORS'
1769 include 'COMMON.FFIELD'
1770 include 'COMMON.CORRMAT'
1771 double precision auxvec(2),auxmat(2,2)
1773 C Compute the virtual-bond-torsional-angle dependent quantities needed
1774 C to calculate the el-loc multibody terms of various order.
1776 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1780 innt=chain_border(1,ii)
1781 inct=chain_border(2,ii)
1782 if (i.gt. innt+2 .and. i.lt.inct+2) then
1783 iti = itype2loc(itype(i-2))
1787 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1788 if (i.gt. innt+1 .and. i.lt.inct+1) then
1789 iti1 = itype2loc(itype(i-1))
1794 cost1=dcos(theta(i-1))
1795 sint1=dsin(theta(i-1))
1797 sint1cub=sint1sq*sint1
1798 sint1cost1=2*sint1*cost1
1800 write (iout,*) "bnew1",i,iti
1801 write (iout,*) (bnew1(k,1,iti),k=1,3)
1802 write (iout,*) (bnew1(k,2,iti),k=1,3)
1803 write (iout,*) "bnew2",i,iti
1804 write (iout,*) (bnew2(k,1,iti),k=1,3)
1805 write (iout,*) (bnew2(k,2,iti),k=1,3)
1808 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1810 gtb1(k,i-2)=cost1*b1k-sint1sq*
1811 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1812 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1814 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1815 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1818 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1819 cc(1,k,i-2)=sint1sq*aux
1820 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1821 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1822 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1823 dd(1,k,i-2)=sint1sq*aux
1824 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1825 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1827 cc(2,1,i-2)=cc(1,2,i-2)
1828 cc(2,2,i-2)=-cc(1,1,i-2)
1829 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1830 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1831 dd(2,1,i-2)=dd(1,2,i-2)
1832 dd(2,2,i-2)=-dd(1,1,i-2)
1833 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1834 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1837 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1838 EE(l,k,i-2)=sint1sq*aux
1840 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1843 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1844 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1845 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1846 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1848 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1849 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1850 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1852 c b1tilde(1,i-2)=b1(1,i-2)
1853 c b1tilde(2,i-2)=-b1(2,i-2)
1854 c b2tilde(1,i-2)=b2(1,i-2)
1855 c b2tilde(2,i-2)=-b2(2,i-2)
1857 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1858 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1859 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1860 write (iout,*) 'theta=', theta(i-1)
1863 if (i.gt. innt+2 .and. i.lt.inct+2) then
1864 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1865 iti = itype2loc(itype(i-2))
1869 c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
1870 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1871 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1872 iti1 = itype2loc(itype(i-1))
1876 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1877 c iti = itype2loc(itype(i-2))
1881 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1882 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1883 c iti1 = itype2loc(itype(i-1))
1893 CC(k,l,i-2)=ccold(k,l,iti)
1894 DD(k,l,i-2)=ddold(k,l,iti)
1895 EE(k,l,i-2)=eeold(k,l,iti)
1899 b1tilde(1,i-2)= b1(1,i-2)
1900 b1tilde(2,i-2)=-b1(2,i-2)
1901 b2tilde(1,i-2)= b2(1,i-2)
1902 b2tilde(2,i-2)=-b2(2,i-2)
1904 Ctilde(1,1,i-2)= CC(1,1,i-2)
1905 Ctilde(1,2,i-2)= CC(1,2,i-2)
1906 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1907 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1909 Dtilde(1,1,i-2)= DD(1,1,i-2)
1910 Dtilde(1,2,i-2)= DD(1,2,i-2)
1911 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1912 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1913 c write(iout,*) "i",i," iti",iti
1914 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1915 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1918 if (i .lt. nres+1) then
1955 if (i .gt. 3 .and. i .lt. nres+1) then
1956 obrot_der(1,i-2)=-sin1
1957 obrot_der(2,i-2)= cos1
1958 Ugder(1,1,i-2)= sin1
1959 Ugder(1,2,i-2)=-cos1
1960 Ugder(2,1,i-2)=-cos1
1961 Ugder(2,2,i-2)=-sin1
1964 obrot2_der(1,i-2)=-dwasin2
1965 obrot2_der(2,i-2)= dwacos2
1966 Ug2der(1,1,i-2)= dwasin2
1967 Ug2der(1,2,i-2)=-dwacos2
1968 Ug2der(2,1,i-2)=-dwacos2
1969 Ug2der(2,2,i-2)=-dwasin2
1971 obrot_der(1,i-2)=0.0d0
1972 obrot_der(2,i-2)=0.0d0
1973 Ugder(1,1,i-2)=0.0d0
1974 Ugder(1,2,i-2)=0.0d0
1975 Ugder(2,1,i-2)=0.0d0
1976 Ugder(2,2,i-2)=0.0d0
1977 obrot2_der(1,i-2)=0.0d0
1978 obrot2_der(2,i-2)=0.0d0
1979 Ug2der(1,1,i-2)=0.0d0
1980 Ug2der(1,2,i-2)=0.0d0
1981 Ug2der(2,1,i-2)=0.0d0
1982 Ug2der(2,2,i-2)=0.0d0
1984 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1985 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1986 iti = itype2loc(itype(i-2))
1990 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1991 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1992 iti1 = itype2loc(itype(i-1))
1996 cd write (iout,*) '*******i',i,' iti1',iti
1997 cd write (iout,*) 'b1',b1(:,iti)
1998 cd write (iout,*) 'b2',b2(:,iti)
1999 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2000 c if (i .gt. iatel_s+2) then
2001 if (i .gt. nnt+2) then
2002 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2004 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2005 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2007 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
2008 c & EE(1,2,iti),EE(2,2,i)
2009 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2010 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2011 c write(iout,*) "Macierz EUG",
2012 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2015 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2017 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
2018 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
2019 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2020 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
2021 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
2033 DtUg2(l,k,i-2)=0.0d0
2037 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2038 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2040 muder(k,i-2)=Ub2der(k,i-2)
2042 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2043 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2044 if (itype(i-1).le.ntyp) then
2045 iti1 = itype2loc(itype(i-1))
2053 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2056 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2057 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2058 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2059 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2060 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2061 & ((ee(l,k,i-2),l=1,2),k=1,2)
2063 cd write (iout,*) 'mu1',mu1(:,i-2)
2064 cd write (iout,*) 'mu2',mu2(:,i-2)
2066 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2069 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2070 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2071 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2072 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2073 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2075 C Vectors and matrices dependent on a single virtual-bond dihedral.
2076 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2077 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2078 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2079 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2080 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2082 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2083 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2084 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2085 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2091 C Matrices dependent on two consecutive virtual-bond dihedrals.
2092 C The order of matrices is from left to right.
2093 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2096 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2098 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2099 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2101 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2102 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2104 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2105 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2106 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2113 C--------------------------------------------------------------------------
2114 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2116 C This subroutine calculates the average interaction energy and its gradient
2117 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2118 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2119 C The potential depends both on the distance of peptide-group centers and on
2120 C the orientation of the CA-CA virtual bonds.
2122 implicit real*8 (a-h,o-z)
2126 include 'DIMENSIONS'
2127 include 'COMMON.CONTROL'
2128 include 'COMMON.IOUNITS'
2129 include 'COMMON.GEO'
2130 include 'COMMON.VAR'
2131 include 'COMMON.LOCAL'
2132 include 'COMMON.CHAIN'
2133 include 'COMMON.DERIV'
2134 include 'COMMON.INTERACT'
2136 include 'COMMON.CONTACTS'
2137 include 'COMMON.CONTMAT'
2139 include 'COMMON.CORRMAT'
2140 include 'COMMON.TORSION'
2141 include 'COMMON.VECTORS'
2142 include 'COMMON.FFIELD'
2143 include 'COMMON.TIME1'
2144 include 'COMMON.SPLITELE'
2145 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2146 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2147 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2148 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2149 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2150 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2152 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2154 double precision scal_el /1.0d0/
2156 double precision scal_el /0.5d0/
2159 C 13-go grudnia roku pamietnego...
2160 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2161 & 0.0d0,1.0d0,0.0d0,
2162 & 0.0d0,0.0d0,1.0d0/
2163 cd write(iout,*) 'In EELEC'
2165 cd write(iout,*) 'Type',i
2166 cd write(iout,*) 'B1',B1(:,i)
2167 cd write(iout,*) 'B2',B2(:,i)
2168 cd write(iout,*) 'CC',CC(:,:,i)
2169 cd write(iout,*) 'DD',DD(:,:,i)
2170 cd write(iout,*) 'EE',EE(:,:,i)
2172 cd call check_vecgrad
2174 if (icheckgrad.eq.1) then
2176 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2178 dc_norm(k,i)=dc(k,i)*fac
2180 c write (iout,*) 'i',i,' fac',fac
2183 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2184 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2185 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2186 c call vec_and_deriv
2192 time_mat=time_mat+MPI_Wtime()-time01
2196 cd write (iout,*) 'i=',i
2198 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2201 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2202 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2217 cd print '(a)','Enter EELEC'
2218 c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2221 gel_loc_loc(i)=0.0d0
2226 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2228 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2230 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2231 do i=iturn3_start,iturn3_end
2233 C write(iout,*) "tu jest i",i
2234 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2235 C changes suggested by Ana to avoid out of bounds
2236 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2237 c & .or.((i+4).gt.nres)
2238 c & .or.((i-1).le.0)
2239 C end of changes by Ana
2240 C dobra zmiana wycofana
2241 & .or. itype(i+2).eq.ntyp1
2242 & .or. itype(i+3).eq.ntyp1) cycle
2243 C Adam: Instructions below will switch off existing interactions
2245 c if(itype(i-1).eq.ntyp1)cycle
2247 c if(i.LT.nres-3)then
2248 c if (itype(i+4).eq.ntyp1) cycle
2253 dx_normi=dc_norm(1,i)
2254 dy_normi=dc_norm(2,i)
2255 dz_normi=dc_norm(3,i)
2256 xmedi=c(1,i)+0.5d0*dxi
2257 ymedi=c(2,i)+0.5d0*dyi
2258 zmedi=c(3,i)+0.5d0*dzi
2259 xmedi=mod(xmedi,boxxsize)
2260 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2261 ymedi=mod(ymedi,boxysize)
2262 if (ymedi.lt.0) ymedi=ymedi+boxysize
2263 zmedi=mod(zmedi,boxzsize)
2264 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2266 call eelecij(i,i+2,ees,evdw1,eel_loc)
2267 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2269 num_cont_hb(i)=num_conti
2272 do i=iturn4_start,iturn4_end
2274 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2275 C changes suggested by Ana to avoid out of bounds
2276 c & .or.((i+5).gt.nres)
2277 c & .or.((i-1).le.0)
2278 C end of changes suggested by Ana
2279 & .or. itype(i+3).eq.ntyp1
2280 & .or. itype(i+4).eq.ntyp1
2281 c & .or. itype(i+5).eq.ntyp1
2282 c & .or. itype(i).eq.ntyp1
2283 c & .or. itype(i-1).eq.ntyp1
2288 dx_normi=dc_norm(1,i)
2289 dy_normi=dc_norm(2,i)
2290 dz_normi=dc_norm(3,i)
2291 xmedi=c(1,i)+0.5d0*dxi
2292 ymedi=c(2,i)+0.5d0*dyi
2293 zmedi=c(3,i)+0.5d0*dzi
2294 C Return atom into box, boxxsize is size of box in x dimension
2296 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2297 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2298 C Condition for being inside the proper box
2299 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2300 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2304 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2305 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2306 C Condition for being inside the proper box
2307 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2308 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2312 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2313 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2314 C Condition for being inside the proper box
2315 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2316 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2319 xmedi=mod(xmedi,boxxsize)
2320 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2321 ymedi=mod(ymedi,boxysize)
2322 if (ymedi.lt.0) ymedi=ymedi+boxysize
2323 zmedi=mod(zmedi,boxzsize)
2324 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2327 num_conti=num_cont_hb(i)
2329 c write(iout,*) "JESTEM W PETLI"
2330 call eelecij(i,i+3,ees,evdw1,eel_loc)
2331 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2332 & call eturn4(i,eello_turn4)
2334 num_cont_hb(i)=num_conti
2337 C Loop over all neighbouring boxes
2342 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2345 do i=iatel_s,iatel_e
2348 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2349 C changes suggested by Ana to avoid out of bounds
2350 c & .or.((i+2).gt.nres)
2351 c & .or.((i-1).le.0)
2352 C end of changes by Ana
2353 c & .or. itype(i+2).eq.ntyp1
2354 c & .or. itype(i-1).eq.ntyp1
2359 dx_normi=dc_norm(1,i)
2360 dy_normi=dc_norm(2,i)
2361 dz_normi=dc_norm(3,i)
2362 xmedi=c(1,i)+0.5d0*dxi
2363 ymedi=c(2,i)+0.5d0*dyi
2364 zmedi=c(3,i)+0.5d0*dzi
2365 xmedi=mod(xmedi,boxxsize)
2366 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2367 ymedi=mod(ymedi,boxysize)
2368 if (ymedi.lt.0) ymedi=ymedi+boxysize
2369 zmedi=mod(zmedi,boxzsize)
2370 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2371 C xmedi=xmedi+xshift*boxxsize
2372 C ymedi=ymedi+yshift*boxysize
2373 C zmedi=zmedi+zshift*boxzsize
2375 C Return tom into box, boxxsize is size of box in x dimension
2377 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2378 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2379 C Condition for being inside the proper box
2380 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2381 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2385 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2386 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2387 C Condition for being inside the proper box
2388 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2389 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2393 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2394 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2395 cC Condition for being inside the proper box
2396 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2397 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2401 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2403 num_conti=num_cont_hb(i)
2406 do j=ielstart(i),ielend(i)
2408 C write (iout,*) i,j
2410 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2411 C changes suggested by Ana to avoid out of bounds
2412 c & .or.((j+2).gt.nres)
2413 c & .or.((j-1).le.0)
2414 C end of changes by Ana
2415 c & .or.itype(j+2).eq.ntyp1
2416 c & .or.itype(j-1).eq.ntyp1
2418 call eelecij(i,j,ees,evdw1,eel_loc)
2421 num_cont_hb(i)=num_conti
2428 c write (iout,*) "Number of loop steps in EELEC:",ind
2430 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2431 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2433 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2434 ccc eel_loc=eel_loc+eello_turn3
2435 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2438 C-------------------------------------------------------------------------------
2439 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2440 implicit real*8 (a-h,o-z)
2441 include 'DIMENSIONS'
2445 include 'COMMON.CONTROL'
2446 include 'COMMON.IOUNITS'
2447 include 'COMMON.GEO'
2448 include 'COMMON.VAR'
2449 include 'COMMON.LOCAL'
2450 include 'COMMON.CHAIN'
2451 include 'COMMON.DERIV'
2452 include 'COMMON.INTERACT'
2454 include 'COMMON.CONTACTS'
2455 include 'COMMON.CONTMAT'
2457 include 'COMMON.CORRMAT'
2458 include 'COMMON.TORSION'
2459 include 'COMMON.VECTORS'
2460 include 'COMMON.FFIELD'
2461 include 'COMMON.TIME1'
2462 include 'COMMON.SPLITELE'
2463 include 'COMMON.SHIELD'
2464 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2465 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2466 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2467 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2468 & gmuij2(4),gmuji2(4)
2469 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2470 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2472 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2474 double precision scal_el /1.0d0/
2476 double precision scal_el /0.5d0/
2479 C 13-go grudnia roku pamietnego...
2480 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2481 & 0.0d0,1.0d0,0.0d0,
2482 & 0.0d0,0.0d0,1.0d0/
2483 integer xshift,yshift,zshift
2484 c time00=MPI_Wtime()
2485 cd write (iout,*) "eelecij",i,j
2489 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2490 aaa=app(iteli,itelj)
2491 bbb=bpp(iteli,itelj)
2492 ael6i=ael6(iteli,itelj)
2493 ael3i=ael3(iteli,itelj)
2497 dx_normj=dc_norm(1,j)
2498 dy_normj=dc_norm(2,j)
2499 dz_normj=dc_norm(3,j)
2500 C xj=c(1,j)+0.5D0*dxj-xmedi
2501 C yj=c(2,j)+0.5D0*dyj-ymedi
2502 C zj=c(3,j)+0.5D0*dzj-zmedi
2507 if (xj.lt.0) xj=xj+boxxsize
2509 if (yj.lt.0) yj=yj+boxysize
2511 if (zj.lt.0) zj=zj+boxzsize
2512 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2513 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2521 xj=xj_safe+xshift*boxxsize
2522 yj=yj_safe+yshift*boxysize
2523 zj=zj_safe+zshift*boxzsize
2524 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2525 if(dist_temp.lt.dist_init) then
2535 if (isubchap.eq.1) then
2544 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2546 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2547 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2548 C Condition for being inside the proper box
2549 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2550 c & (xj.lt.((-0.5d0)*boxxsize))) then
2554 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2555 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2556 C Condition for being inside the proper box
2557 c if ((yj.gt.((0.5d0)*boxysize)).or.
2558 c & (yj.lt.((-0.5d0)*boxysize))) then
2562 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2563 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2564 C Condition for being inside the proper box
2565 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2566 c & (zj.lt.((-0.5d0)*boxzsize))) then
2569 C endif !endPBC condintion
2573 rij=xj*xj+yj*yj+zj*zj
2575 sss=sscale(sqrt(rij))
2576 if (sss.eq.0.0d0) return
2577 sssgrad=sscagrad(sqrt(rij))
2578 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2579 c & " rlamb",rlamb," sss",sss
2580 c if (sss.gt.0.0d0) then
2586 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2587 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2588 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2589 fac=cosa-3.0D0*cosb*cosg
2591 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2592 if (j.eq.i+2) ev1=scal_el*ev1
2597 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2601 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2602 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2603 if (shield_mode.gt.0) then
2606 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2607 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2616 evdw1=evdw1+evdwij*sss
2617 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2618 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2619 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2620 cd & xmedi,ymedi,zmedi,xj,yj,zj
2622 if (energy_dec) then
2623 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2625 &,iteli,itelj,aaa,evdw1,sss
2626 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2627 &fac_shield(i),fac_shield(j)
2631 C Calculate contributions to the Cartesian gradient.
2634 facvdw=-6*rrmij*(ev1+evdwij)*sss
2635 facel=-3*rrmij*(el1+eesij)
2642 * Radial derivatives. First process both termini of the fragment (i,j)
2648 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2649 & (shield_mode.gt.0)) then
2651 do ilist=1,ishield_list(i)
2652 iresshield=shield_list(ilist,i)
2654 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2656 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2658 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2659 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2660 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2661 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2662 C if (iresshield.gt.i) then
2663 C do ishi=i+1,iresshield-1
2664 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2665 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2669 C do ishi=iresshield,i
2670 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2671 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2677 do ilist=1,ishield_list(j)
2678 iresshield=shield_list(ilist,j)
2680 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2682 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2684 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2685 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2687 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2688 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2689 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2690 C if (iresshield.gt.j) then
2691 C do ishi=j+1,iresshield-1
2692 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2693 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2697 C do ishi=iresshield,j
2698 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2699 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2706 gshieldc(k,i)=gshieldc(k,i)+
2707 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2708 gshieldc(k,j)=gshieldc(k,j)+
2709 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2710 gshieldc(k,i-1)=gshieldc(k,i-1)+
2711 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2712 gshieldc(k,j-1)=gshieldc(k,j-1)+
2713 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2718 c ghalf=0.5D0*ggg(k)
2719 c gelc(k,i)=gelc(k,i)+ghalf
2720 c gelc(k,j)=gelc(k,j)+ghalf
2722 c 9/28/08 AL Gradient compotents will be summed only at the end
2723 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2725 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2726 C & +grad_shield(k,j)*eesij/fac_shield(j)
2727 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2728 C & +grad_shield(k,i)*eesij/fac_shield(i)
2729 C gelc_long(k,i-1)=gelc_long(k,i-1)
2730 C & +grad_shield(k,i)*eesij/fac_shield(i)
2731 C gelc_long(k,j-1)=gelc_long(k,j-1)
2732 C & +grad_shield(k,j)*eesij/fac_shield(j)
2734 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2737 * Loop over residues i+1 thru j-1.
2741 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2744 if (sss.gt.0.0) then
2745 facvdw=facvdw+sssgrad*rmij*evdwij
2755 c ghalf=0.5D0*ggg(k)
2756 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2757 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2759 c 9/28/08 AL Gradient compotents will be summed only at the end
2761 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2762 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2765 * Loop over residues i+1 thru j-1.
2769 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2778 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2779 & +(evdwij+eesij)*sssgrad*rrmij
2784 * Radial derivatives. First process both termini of the fragment (i,j)
2788 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2790 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2792 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2794 c ghalf=0.5D0*ggg(k)
2795 c gelc(k,i)=gelc(k,i)+ghalf
2796 c gelc(k,j)=gelc(k,j)+ghalf
2798 c 9/28/08 AL Gradient compotents will be summed only at the end
2800 gelc_long(k,j)=gelc(k,j)+ggg(k)
2801 gelc_long(k,i)=gelc(k,i)-ggg(k)
2804 * Loop over residues i+1 thru j-1.
2808 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2811 c 9/28/08 AL Gradient compotents will be summed only at the end
2812 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2813 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2814 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2816 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2817 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2825 ecosa=2.0D0*fac3*fac1+fac4
2828 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2829 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2831 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2832 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2834 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2835 cd & (dcosg(k),k=1,3)
2837 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2838 & fac_shield(i)**2*fac_shield(j)**2
2841 c ghalf=0.5D0*ggg(k)
2842 c gelc(k,i)=gelc(k,i)+ghalf
2843 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2844 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2845 c gelc(k,j)=gelc(k,j)+ghalf
2846 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2847 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2851 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2854 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2857 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2858 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2859 & *fac_shield(i)**2*fac_shield(j)**2
2861 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2862 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2863 & *fac_shield(i)**2*fac_shield(j)**2
2864 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2865 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2867 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2872 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2873 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2874 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2876 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2877 C energy of a peptide unit is assumed in the form of a second-order
2878 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2879 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2880 C are computed for EVERY pair of non-contiguous peptide groups.
2883 if (j.lt.nres-1) then
2895 muij(kkk)=mu(k,i)*mu(l,j)
2896 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2899 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2900 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2901 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2902 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2903 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2904 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2910 write (iout,*) 'EELEC: i',i,' j',j
2911 write (iout,*) 'j',j,' j1',j1,' j2',j2
2912 write(iout,*) 'muij',muij
2913 write (iout,*) "uy",uy(:,i)
2914 write (iout,*) "uz",uz(:,j)
2915 write (iout,*) "erij",erij
2917 ury=scalar(uy(1,i),erij)
2918 urz=scalar(uz(1,i),erij)
2919 vry=scalar(uy(1,j),erij)
2920 vrz=scalar(uz(1,j),erij)
2921 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2922 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2923 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2924 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2925 fac=dsqrt(-ael6i)*r3ij
2930 cd write (iout,'(4i5,4f10.5)')
2931 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2932 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2933 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2934 cd & uy(:,j),uz(:,j)
2935 cd write (iout,'(4f10.5)')
2936 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2937 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2938 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2939 cd write (iout,'(9f10.5/)')
2940 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2941 C Derivatives of the elements of A in virtual-bond vectors
2943 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2945 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2946 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2947 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2948 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2949 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2950 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2951 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2952 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2953 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2954 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2955 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2956 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2958 C Compute radial contributions to the gradient
2976 C Add the contributions coming from er
2979 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2980 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2981 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2982 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2985 C Derivatives in DC(i)
2986 cgrad ghalf1=0.5d0*agg(k,1)
2987 cgrad ghalf2=0.5d0*agg(k,2)
2988 cgrad ghalf3=0.5d0*agg(k,3)
2989 cgrad ghalf4=0.5d0*agg(k,4)
2990 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2991 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2992 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2993 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2994 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2995 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2996 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2997 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2998 C Derivatives in DC(i+1)
2999 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3000 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3001 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3002 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3003 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3004 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3005 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3006 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3007 C Derivatives in DC(j)
3008 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3009 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3010 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3011 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3012 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3013 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3014 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3015 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3016 C Derivatives in DC(j+1) or DC(nres-1)
3017 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3018 & -3.0d0*vryg(k,3)*ury)
3019 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3020 & -3.0d0*vrzg(k,3)*ury)
3021 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3022 & -3.0d0*vryg(k,3)*urz)
3023 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3024 & -3.0d0*vrzg(k,3)*urz)
3025 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3027 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3042 aggi(k,l)=-aggi(k,l)
3043 aggi1(k,l)=-aggi1(k,l)
3044 aggj(k,l)=-aggj(k,l)
3045 aggj1(k,l)=-aggj1(k,l)
3049 if (j.lt.nres-1) then
3055 aggi(k,l)=-aggi(k,l)
3056 aggi1(k,l)=-aggi1(k,l)
3057 aggj(k,l)=-aggj(k,l)
3058 aggj1(k,l)=-aggj1(k,l)
3069 aggi(k,l)=-aggi(k,l)
3070 aggi1(k,l)=-aggi1(k,l)
3071 aggj(k,l)=-aggj(k,l)
3072 aggj1(k,l)=-aggj1(k,l)
3077 IF (wel_loc.gt.0.0d0) THEN
3078 C Contribution to the local-electrostatic energy coming from the i-j pair
3079 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3082 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
3084 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
3085 & " wel_loc",wel_loc
3087 if (shield_mode.eq.0) then
3094 eel_loc_ij=eel_loc_ij
3095 & *fac_shield(i)*fac_shield(j)
3096 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3097 & 'eelloc',i,j,eel_loc_ij
3098 c if (eel_loc_ij.ne.0)
3099 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3100 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3102 eel_loc=eel_loc+eel_loc_ij*sss
3103 C Now derivative over eel_loc
3105 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3106 & (shield_mode.gt.0)) then
3109 do ilist=1,ishield_list(i)
3110 iresshield=shield_list(ilist,i)
3112 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
3115 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3117 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
3118 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3122 do ilist=1,ishield_list(j)
3123 iresshield=shield_list(ilist,j)
3125 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
3128 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3130 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3131 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3138 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3139 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3140 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3141 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3142 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3143 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3144 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3145 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3150 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3151 c & ' eel_loc_ij',eel_loc_ij
3152 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3153 C Calculate patrial derivative for theta angle
3155 geel_loc_ij=(a22*gmuij1(1)
3159 & *fac_shield(i)*fac_shield(j)*sss
3160 c write(iout,*) "derivative over thatai"
3161 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3163 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3164 & geel_loc_ij*wel_loc
3165 c write(iout,*) "derivative over thatai-1"
3166 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3173 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3174 & geel_loc_ij*wel_loc
3175 & *fac_shield(i)*fac_shield(j)*sss
3177 c Derivative over j residue
3178 geel_loc_ji=a22*gmuji1(1)
3182 c write(iout,*) "derivative over thataj"
3183 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3186 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3187 & geel_loc_ji*wel_loc
3188 & *fac_shield(i)*fac_shield(j)
3195 c write(iout,*) "derivative over thataj-1"
3196 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3198 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3199 & geel_loc_ji*wel_loc
3200 & *fac_shield(i)*fac_shield(j)*sss
3202 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3204 C Partial derivatives in virtual-bond dihedral angles gamma
3206 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3207 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3208 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3209 & *fac_shield(i)*fac_shield(j)
3211 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3212 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3213 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3214 & *fac_shield(i)*fac_shield(j)
3215 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3216 aux=eel_loc_ij/sss*sssgrad*rmij
3221 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3222 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3223 & *fac_shield(i)*fac_shield(j)*sss
3224 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3225 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3226 cgrad ghalf=0.5d0*ggg(l)
3227 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3228 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3232 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3235 C Remaining derivatives of eello
3237 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3238 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3239 & *fac_shield(i)*fac_shield(j)
3241 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3242 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3243 & *fac_shield(i)*fac_shield(j)
3245 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3246 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3247 & *fac_shield(i)*fac_shield(j)
3249 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3250 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3251 & *fac_shield(i)*fac_shield(j)
3258 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3259 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3261 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3262 & .and. num_conti.le.maxconts) then
3263 c write (iout,*) i,j," entered corr"
3265 C Calculate the contact function. The ith column of the array JCONT will
3266 C contain the numbers of atoms that make contacts with the atom I (of numbers
3267 C greater than I). The arrays FACONT and GACONT will contain the values of
3268 C the contact function and its derivative.
3269 c r0ij=1.02D0*rpp(iteli,itelj)
3270 c r0ij=1.11D0*rpp(iteli,itelj)
3271 r0ij=2.20D0*rpp(iteli,itelj)
3272 c r0ij=1.55D0*rpp(iteli,itelj)
3273 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3274 if (fcont.gt.0.0D0) then
3275 num_conti=num_conti+1
3276 if (num_conti.gt.maxconts) then
3277 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3278 & ' will skip next contacts for this conf.'
3280 jcont_hb(num_conti,i)=j
3281 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3282 cd & " jcont_hb",jcont_hb(num_conti,i)
3283 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3284 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3285 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3287 d_cont(num_conti,i)=rij
3288 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3289 C --- Electrostatic-interaction matrix ---
3290 a_chuj(1,1,num_conti,i)=a22
3291 a_chuj(1,2,num_conti,i)=a23
3292 a_chuj(2,1,num_conti,i)=a32
3293 a_chuj(2,2,num_conti,i)=a33
3294 C --- Gradient of rij
3297 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3304 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3305 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3306 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3307 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3308 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3314 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3315 C Calculate contact energies
3317 wij=cosa-3.0D0*cosb*cosg
3320 c fac3=dsqrt(-ael6i)/r0ij**3
3321 fac3=dsqrt(-ael6i)*r3ij
3322 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3323 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3324 if (ees0tmp.gt.0) then
3325 ees0pij=dsqrt(ees0tmp)
3329 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3330 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3331 if (ees0tmp.gt.0) then
3332 ees0mij=dsqrt(ees0tmp)
3337 if (shield_mode.eq.0) then
3341 ees0plist(num_conti,i)=j
3342 C fac_shield(i)=0.4d0
3343 C fac_shield(j)=0.6d0
3345 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3346 & *fac_shield(i)*fac_shield(j)
3347 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3348 & *fac_shield(i)*fac_shield(j)
3349 C Diagnostics. Comment out or remove after debugging!
3350 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3351 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3352 c ees0m(num_conti,i)=0.0D0
3354 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3355 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3356 C Angular derivatives of the contact function
3358 ees0pij1=fac3/ees0pij
3359 ees0mij1=fac3/ees0mij
3360 fac3p=-3.0D0*fac3*rrmij
3361 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3362 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3364 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3365 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3366 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3367 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3368 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3369 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3370 ecosap=ecosa1+ecosa2
3371 ecosbp=ecosb1+ecosb2
3372 ecosgp=ecosg1+ecosg2
3373 ecosam=ecosa1-ecosa2
3374 ecosbm=ecosb1-ecosb2
3375 ecosgm=ecosg1-ecosg2
3384 facont_hb(num_conti,i)=fcont
3387 fprimcont=fprimcont/rij
3388 cd facont_hb(num_conti,i)=1.0D0
3389 C Following line is for diagnostics.
3392 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3393 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3396 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3397 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3399 gggp(1)=gggp(1)+ees0pijp*xj
3400 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3401 gggp(2)=gggp(2)+ees0pijp*yj
3402 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3403 gggp(3)=gggp(3)+ees0pijp*zj
3404 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3405 gggm(1)=gggm(1)+ees0mijp*xj
3406 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3407 gggm(2)=gggm(2)+ees0mijp*yj
3408 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3409 gggm(3)=gggm(3)+ees0mijp*zj
3410 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3411 C Derivatives due to the contact function
3412 gacont_hbr(1,num_conti,i)=fprimcont*xj
3413 gacont_hbr(2,num_conti,i)=fprimcont*yj
3414 gacont_hbr(3,num_conti,i)=fprimcont*zj
3417 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3418 c following the change of gradient-summation algorithm.
3420 cgrad ghalfp=0.5D0*gggp(k)
3421 cgrad ghalfm=0.5D0*gggm(k)
3422 gacontp_hb1(k,num_conti,i)=!ghalfp
3423 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3424 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3425 & *fac_shield(i)*fac_shield(j)*sss
3427 gacontp_hb2(k,num_conti,i)=!ghalfp
3428 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3429 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3430 & *fac_shield(i)*fac_shield(j)*sss
3432 gacontp_hb3(k,num_conti,i)=gggp(k)
3433 & *fac_shield(i)*fac_shield(j)*sss
3435 gacontm_hb1(k,num_conti,i)=!ghalfm
3436 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3437 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3438 & *fac_shield(i)*fac_shield(j)*sss
3440 gacontm_hb2(k,num_conti,i)=!ghalfm
3441 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3442 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3443 & *fac_shield(i)*fac_shield(j)*sss
3445 gacontm_hb3(k,num_conti,i)=gggm(k)
3446 & *fac_shield(i)*fac_shield(j)
3449 C Diagnostics. Comment out or remove after debugging!
3451 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3452 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3453 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3454 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3455 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3456 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3462 endif ! num_conti.le.maxconts
3467 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3470 ghalf=0.5d0*agg(l,k)
3471 aggi(l,k)=aggi(l,k)+ghalf
3472 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3473 aggj(l,k)=aggj(l,k)+ghalf
3476 if (j.eq.nres-1 .and. i.lt.j-2) then
3479 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3485 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3488 C-----------------------------------------------------------------------------
3489 subroutine eturn3(i,eello_turn3)
3490 C Third- and fourth-order contributions from turns
3491 implicit real*8 (a-h,o-z)
3492 include 'DIMENSIONS'
3493 include 'COMMON.IOUNITS'
3494 include 'COMMON.GEO'
3495 include 'COMMON.VAR'
3496 include 'COMMON.LOCAL'
3497 include 'COMMON.CHAIN'
3498 include 'COMMON.DERIV'
3499 include 'COMMON.INTERACT'
3500 include 'COMMON.CORRMAT'
3501 include 'COMMON.TORSION'
3502 include 'COMMON.VECTORS'
3503 include 'COMMON.FFIELD'
3504 include 'COMMON.CONTROL'
3505 include 'COMMON.SHIELD'
3507 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3508 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3509 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3510 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3511 & auxgmat2(2,2),auxgmatt2(2,2)
3512 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3513 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3514 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3515 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3518 c write (iout,*) "eturn3",i,j,j1,j2
3523 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3525 C Third-order contributions
3532 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3533 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3534 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3535 c auxalary matices for theta gradient
3536 c auxalary matrix for i+1 and constant i+2
3537 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3538 c auxalary matrix for i+2 and constant i+1
3539 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3540 call transpose2(auxmat(1,1),auxmat1(1,1))
3541 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3542 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3543 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3544 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3545 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3546 if (shield_mode.eq.0) then
3553 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3554 & *fac_shield(i)*fac_shield(j)
3555 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3556 & *fac_shield(i)*fac_shield(j)
3557 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3561 C Derivatives in theta
3562 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3563 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3564 & *fac_shield(i)*fac_shield(j)
3565 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3566 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3567 & *fac_shield(i)*fac_shield(j)
3570 C Derivatives in shield mode
3571 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3572 & (shield_mode.gt.0)) then
3575 do ilist=1,ishield_list(i)
3576 iresshield=shield_list(ilist,i)
3578 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3580 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3582 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3583 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3587 do ilist=1,ishield_list(j)
3588 iresshield=shield_list(ilist,j)
3590 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3592 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3594 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3595 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3602 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3603 & grad_shield(k,i)*eello_t3/fac_shield(i)
3604 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3605 & grad_shield(k,j)*eello_t3/fac_shield(j)
3606 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3607 & grad_shield(k,i)*eello_t3/fac_shield(i)
3608 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3609 & grad_shield(k,j)*eello_t3/fac_shield(j)
3613 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3614 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3615 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3616 cd & ' eello_turn3_num',4*eello_turn3_num
3617 C Derivatives in gamma(i)
3618 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3619 call transpose2(auxmat2(1,1),auxmat3(1,1))
3620 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3621 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3622 & *fac_shield(i)*fac_shield(j)
3623 C Derivatives in gamma(i+1)
3624 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3625 call transpose2(auxmat2(1,1),auxmat3(1,1))
3626 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3627 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3628 & +0.5d0*(pizda(1,1)+pizda(2,2))
3629 & *fac_shield(i)*fac_shield(j)
3630 C Cartesian derivatives
3632 c ghalf1=0.5d0*agg(l,1)
3633 c ghalf2=0.5d0*agg(l,2)
3634 c ghalf3=0.5d0*agg(l,3)
3635 c ghalf4=0.5d0*agg(l,4)
3636 a_temp(1,1)=aggi(l,1)!+ghalf1
3637 a_temp(1,2)=aggi(l,2)!+ghalf2
3638 a_temp(2,1)=aggi(l,3)!+ghalf3
3639 a_temp(2,2)=aggi(l,4)!+ghalf4
3640 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3641 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3642 & +0.5d0*(pizda(1,1)+pizda(2,2))
3643 & *fac_shield(i)*fac_shield(j)
3645 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3646 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3647 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3648 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3649 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3650 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3651 & +0.5d0*(pizda(1,1)+pizda(2,2))
3652 & *fac_shield(i)*fac_shield(j)
3653 a_temp(1,1)=aggj(l,1)!+ghalf1
3654 a_temp(1,2)=aggj(l,2)!+ghalf2
3655 a_temp(2,1)=aggj(l,3)!+ghalf3
3656 a_temp(2,2)=aggj(l,4)!+ghalf4
3657 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3658 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3659 & +0.5d0*(pizda(1,1)+pizda(2,2))
3660 & *fac_shield(i)*fac_shield(j)
3661 a_temp(1,1)=aggj1(l,1)
3662 a_temp(1,2)=aggj1(l,2)
3663 a_temp(2,1)=aggj1(l,3)
3664 a_temp(2,2)=aggj1(l,4)
3665 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3666 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3667 & +0.5d0*(pizda(1,1)+pizda(2,2))
3668 & *fac_shield(i)*fac_shield(j)
3675 C-------------------------------------------------------------------------------
3676 subroutine eturn4(i,eello_turn4)
3677 C Third- and fourth-order contributions from turns
3678 implicit real*8 (a-h,o-z)
3679 include 'DIMENSIONS'
3680 include 'COMMON.IOUNITS'
3681 include 'COMMON.GEO'
3682 include 'COMMON.VAR'
3683 include 'COMMON.LOCAL'
3684 include 'COMMON.CHAIN'
3685 include 'COMMON.DERIV'
3686 include 'COMMON.INTERACT'
3687 include 'COMMON.CORRMAT'
3688 include 'COMMON.TORSION'
3689 include 'COMMON.VECTORS'
3690 include 'COMMON.FFIELD'
3691 include 'COMMON.CONTROL'
3692 include 'COMMON.SHIELD'
3694 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3695 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3696 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3697 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3698 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3699 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3700 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3701 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3702 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3703 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3704 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3707 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3709 C Fourth-order contributions
3717 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3718 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3719 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3720 c write(iout,*)"WCHODZE W PROGRAM"
3725 iti1=itype2loc(itype(i+1))
3726 iti2=itype2loc(itype(i+2))
3727 iti3=itype2loc(itype(i+3))
3728 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3729 call transpose2(EUg(1,1,i+1),e1t(1,1))
3730 call transpose2(Eug(1,1,i+2),e2t(1,1))
3731 call transpose2(Eug(1,1,i+3),e3t(1,1))
3732 C Ematrix derivative in theta
3733 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3734 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3735 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3736 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3737 c eta1 in derivative theta
3738 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3739 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3740 c auxgvec is derivative of Ub2 so i+3 theta
3741 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3742 c auxalary matrix of E i+1
3743 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3746 s1=scalar2(b1(1,i+2),auxvec(1))
3747 c derivative of theta i+2 with constant i+3
3748 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3749 c derivative of theta i+2 with constant i+2
3750 gs32=scalar2(b1(1,i+2),auxgvec(1))
3751 c derivative of E matix in theta of i+1
3752 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3754 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3755 c ea31 in derivative theta
3756 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3757 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3758 c auxilary matrix auxgvec of Ub2 with constant E matirx
3759 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3760 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3761 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3765 s2=scalar2(b1(1,i+1),auxvec(1))
3766 c derivative of theta i+1 with constant i+3
3767 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3768 c derivative of theta i+2 with constant i+1
3769 gs21=scalar2(b1(1,i+1),auxgvec(1))
3770 c derivative of theta i+3 with constant i+1
3771 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3772 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3774 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3775 c two derivatives over diffetent matrices
3776 c gtae3e2 is derivative over i+3
3777 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3778 c ae3gte2 is derivative over i+2
3779 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3780 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3781 c three possible derivative over theta E matices
3783 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3785 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3787 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3788 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3790 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3791 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3792 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3793 if (shield_mode.eq.0) then
3800 eello_turn4=eello_turn4-(s1+s2+s3)
3801 & *fac_shield(i)*fac_shield(j)
3802 eello_t4=-(s1+s2+s3)
3803 & *fac_shield(i)*fac_shield(j)
3804 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3805 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3806 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3807 C Now derivative over shield:
3808 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3809 & (shield_mode.gt.0)) then
3812 do ilist=1,ishield_list(i)
3813 iresshield=shield_list(ilist,i)
3815 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3817 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3819 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3820 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3824 do ilist=1,ishield_list(j)
3825 iresshield=shield_list(ilist,j)
3827 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3829 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3831 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3832 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3839 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3840 & grad_shield(k,i)*eello_t4/fac_shield(i)
3841 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3842 & grad_shield(k,j)*eello_t4/fac_shield(j)
3843 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3844 & grad_shield(k,i)*eello_t4/fac_shield(i)
3845 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3846 & grad_shield(k,j)*eello_t4/fac_shield(j)
3849 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3850 cd & ' eello_turn4_num',8*eello_turn4_num
3852 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3853 & -(gs13+gsE13+gsEE1)*wturn4
3854 & *fac_shield(i)*fac_shield(j)
3855 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3856 & -(gs23+gs21+gsEE2)*wturn4
3857 & *fac_shield(i)*fac_shield(j)
3859 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3860 & -(gs32+gsE31+gsEE3)*wturn4
3861 & *fac_shield(i)*fac_shield(j)
3863 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3866 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3867 & 'eturn4',i,j,-(s1+s2+s3)
3868 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3869 c & ' eello_turn4_num',8*eello_turn4_num
3870 C Derivatives in gamma(i)
3871 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3872 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3873 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3874 s1=scalar2(b1(1,i+2),auxvec(1))
3875 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3876 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3877 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3878 & *fac_shield(i)*fac_shield(j)
3879 C Derivatives in gamma(i+1)
3880 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3881 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3882 s2=scalar2(b1(1,i+1),auxvec(1))
3883 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3884 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3885 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3886 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3887 & *fac_shield(i)*fac_shield(j)
3888 C Derivatives in gamma(i+2)
3889 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3890 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3891 s1=scalar2(b1(1,i+2),auxvec(1))
3892 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3893 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3894 s2=scalar2(b1(1,i+1),auxvec(1))
3895 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3896 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3897 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3898 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3899 & *fac_shield(i)*fac_shield(j)
3901 C Cartesian derivatives
3902 C Derivatives of this turn contributions in DC(i+2)
3903 if (j.lt.nres-1) then
3905 a_temp(1,1)=agg(l,1)
3906 a_temp(1,2)=agg(l,2)
3907 a_temp(2,1)=agg(l,3)
3908 a_temp(2,2)=agg(l,4)
3909 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3910 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3911 s1=scalar2(b1(1,i+2),auxvec(1))
3912 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3913 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3914 s2=scalar2(b1(1,i+1),auxvec(1))
3915 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3916 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3917 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3919 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3920 & *fac_shield(i)*fac_shield(j)
3923 C Remaining derivatives of this turn contribution
3925 a_temp(1,1)=aggi(l,1)
3926 a_temp(1,2)=aggi(l,2)
3927 a_temp(2,1)=aggi(l,3)
3928 a_temp(2,2)=aggi(l,4)
3929 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3930 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3931 s1=scalar2(b1(1,i+2),auxvec(1))
3932 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3933 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3934 s2=scalar2(b1(1,i+1),auxvec(1))
3935 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3936 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3937 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3938 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3939 & *fac_shield(i)*fac_shield(j)
3940 a_temp(1,1)=aggi1(l,1)
3941 a_temp(1,2)=aggi1(l,2)
3942 a_temp(2,1)=aggi1(l,3)
3943 a_temp(2,2)=aggi1(l,4)
3944 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3945 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3946 s1=scalar2(b1(1,i+2),auxvec(1))
3947 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3948 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3949 s2=scalar2(b1(1,i+1),auxvec(1))
3950 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3951 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3952 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3953 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3954 & *fac_shield(i)*fac_shield(j)
3955 a_temp(1,1)=aggj(l,1)
3956 a_temp(1,2)=aggj(l,2)
3957 a_temp(2,1)=aggj(l,3)
3958 a_temp(2,2)=aggj(l,4)
3959 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3960 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3961 s1=scalar2(b1(1,i+2),auxvec(1))
3962 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3963 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3964 s2=scalar2(b1(1,i+1),auxvec(1))
3965 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3966 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3967 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3968 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3969 & *fac_shield(i)*fac_shield(j)
3970 a_temp(1,1)=aggj1(l,1)
3971 a_temp(1,2)=aggj1(l,2)
3972 a_temp(2,1)=aggj1(l,3)
3973 a_temp(2,2)=aggj1(l,4)
3974 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3975 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3976 s1=scalar2(b1(1,i+2),auxvec(1))
3977 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3978 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3979 s2=scalar2(b1(1,i+1),auxvec(1))
3980 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3981 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3982 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3983 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3984 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3985 & *fac_shield(i)*fac_shield(j)
3992 C-----------------------------------------------------------------------------
3993 subroutine vecpr(u,v,w)
3994 implicit real*8(a-h,o-z)
3995 dimension u(3),v(3),w(3)
3996 w(1)=u(2)*v(3)-u(3)*v(2)
3997 w(2)=-u(1)*v(3)+u(3)*v(1)
3998 w(3)=u(1)*v(2)-u(2)*v(1)
4001 C-----------------------------------------------------------------------------
4002 subroutine unormderiv(u,ugrad,unorm,ungrad)
4003 C This subroutine computes the derivatives of a normalized vector u, given
4004 C the derivatives computed without normalization conditions, ugrad. Returns
4007 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4008 double precision vec(3)
4009 double precision scalar
4011 c write (2,*) 'ugrad',ugrad
4014 vec(i)=scalar(ugrad(1,i),u(1))
4016 c write (2,*) 'vec',vec
4019 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4022 c write (2,*) 'ungrad',ungrad
4025 C-----------------------------------------------------------------------------
4026 subroutine escp(evdw2,evdw2_14)
4028 C This subroutine calculates the excluded-volume interaction energy between
4029 C peptide-group centers and side chains and its gradient in virtual-bond and
4030 C side-chain vectors.
4032 implicit real*8 (a-h,o-z)
4033 include 'DIMENSIONS'
4034 include 'COMMON.GEO'
4035 include 'COMMON.VAR'
4036 include 'COMMON.LOCAL'
4037 include 'COMMON.CHAIN'
4038 include 'COMMON.DERIV'
4039 include 'COMMON.INTERACT'
4040 include 'COMMON.FFIELD'
4041 include 'COMMON.IOUNITS'
4045 cd print '(a)','Enter ESCP'
4046 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4047 c & ' scal14',scal14
4048 do i=iatscp_s,iatscp_e
4049 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4051 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4052 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4053 if (iteli.eq.0) goto 1225
4054 xi=0.5D0*(c(1,i)+c(1,i+1))
4055 yi=0.5D0*(c(2,i)+c(2,i+1))
4056 zi=0.5D0*(c(3,i)+c(3,i+1))
4057 C Returning the ith atom to box
4059 if (xi.lt.0) xi=xi+boxxsize
4061 if (yi.lt.0) yi=yi+boxysize
4063 if (zi.lt.0) zi=zi+boxzsize
4064 do iint=1,nscp_gr(i)
4066 do j=iscpstart(i,iint),iscpend(i,iint)
4067 itypj=iabs(itype(j))
4068 if (itypj.eq.ntyp1) cycle
4069 C Uncomment following three lines for SC-p interactions
4073 C Uncomment following three lines for Ca-p interactions
4077 C returning the jth atom to box
4079 if (xj.lt.0) xj=xj+boxxsize
4081 if (yj.lt.0) yj=yj+boxysize
4083 if (zj.lt.0) zj=zj+boxzsize
4084 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4089 C Finding the closest jth atom
4093 xj=xj_safe+xshift*boxxsize
4094 yj=yj_safe+yshift*boxysize
4095 zj=zj_safe+zshift*boxzsize
4096 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4097 if(dist_temp.lt.dist_init) then
4107 if (subchap.eq.1) then
4116 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4117 C sss is scaling function for smoothing the cutoff gradient otherwise
4118 C the gradient would not be continuouse
4119 sss=sscale(1.0d0/(dsqrt(rrij)))
4120 if (sss.le.0.0d0) cycle
4121 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4123 e1=fac*fac*aad(itypj,iteli)
4124 e2=fac*bad(itypj,iteli)
4125 if (iabs(j-i) .le. 2) then
4128 evdw2_14=evdw2_14+(e1+e2)*sss
4131 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4132 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4133 c & bad(itypj,iteli)
4134 evdw2=evdw2+evdwij*sss
4137 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4139 fac=-(evdwij+e1)*rrij*sss
4140 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4145 cd write (iout,*) 'j<i'
4146 C Uncomment following three lines for SC-p interactions
4148 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4151 cd write (iout,*) 'j>i'
4154 C Uncomment following line for SC-p interactions
4155 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4159 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4163 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4164 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4167 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4177 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4178 gradx_scp(j,i)=expon*gradx_scp(j,i)
4181 C******************************************************************************
4185 C To save time the factor EXPON has been extracted from ALL components
4186 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4189 C******************************************************************************
4192 C--------------------------------------------------------------------------
4193 subroutine edis(ehpb)
4195 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4197 implicit real*8 (a-h,o-z)
4198 include 'DIMENSIONS'
4199 include 'COMMON.SBRIDGE'
4200 include 'COMMON.CHAIN'
4201 include 'COMMON.DERIV'
4202 include 'COMMON.VAR'
4203 include 'COMMON.INTERACT'
4204 include 'COMMON.CONTROL'
4205 include 'COMMON.IOUNITS'
4206 dimension ggg(3),ggg_peak(3,1000)
4209 c 8/21/18 AL: added explicit restraints on reference coords
4210 c write (iout,*) "restr_on_coord",restr_on_coord
4211 if (restr_on_coord) then
4215 if (itype(i).eq.ntyp1) cycle
4217 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4218 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4220 if (itype(i).ne.10) then
4222 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4223 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4226 if (energy_dec) write (iout,*)
4227 & "i",i," bfac",bfac(i)," ecoor",ecoor
4228 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4232 C write (iout,*) ,"link_end",link_end,constr_dist
4233 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4234 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4235 c & " constr_dist",constr_dist
4236 if (link_end.eq.0.and.link_end_peak.eq.0) return
4237 do i=link_start_peak,link_end_peak
4239 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4240 c & ipeak(1,i),ipeak(2,i)
4241 do ip=ipeak(1,i),ipeak(2,i)
4246 C iii and jjj point to the residues for which the distance is assigned.
4247 c if (ii.gt.nres) then
4254 if (ii.gt.nres) then
4259 if (jj.gt.nres) then
4264 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4265 aux=dexp(-scal_peak*aux)
4266 ehpb_peak=ehpb_peak+aux
4267 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4268 & forcon_peak(ip))*aux/dd
4270 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4272 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4273 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4274 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4276 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4277 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4278 do ip=ipeak(1,i),ipeak(2,i)
4281 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4285 C iii and jjj point to the residues for which the distance is assigned.
4286 c if (ii.gt.nres) then
4293 if (ii.gt.nres) then
4298 if (jj.gt.nres) then
4305 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4310 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4314 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4315 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4319 do i=link_start,link_end
4320 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4321 C CA-CA distance used in regularization of structure.
4324 C iii and jjj point to the residues for which the distance is assigned.
4325 c if (ii.gt.nres) then
4332 if (ii.gt.nres) then
4337 if (jj.gt.nres) then
4342 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4343 c & dhpb(i),dhpb1(i),forcon(i)
4344 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4345 C distance and angle dependent SS bond potential.
4346 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4347 C & iabs(itype(jjj)).eq.1) then
4348 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4349 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4350 if (.not.dyn_ss .and. i.le.nss) then
4351 C 15/02/13 CC dynamic SSbond - additional check
4352 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4353 & iabs(itype(jjj)).eq.1) then
4354 call ssbond_ene(iii,jjj,eij)
4357 cd write (iout,*) "eij",eij
4358 cd & ' waga=',waga,' fac=',fac
4359 ! else if (ii.gt.nres .and. jj.gt.nres) then
4361 C Calculate the distance between the two points and its difference from the
4364 if (irestr_type(i).eq.11) then
4365 ehpb=ehpb+fordepth(i)!**4.0d0
4366 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4367 fac=fordepth(i)!**4.0d0
4368 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4369 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4370 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4371 & ehpb,irestr_type(i)
4372 else if (irestr_type(i).eq.10) then
4373 c AL 6//19/2018 cross-link restraints
4374 xdis = 0.5d0*(dd/forcon(i))**2
4375 expdis = dexp(-xdis)
4376 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4377 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4378 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4379 c & " wboltzd",wboltzd
4380 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4381 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4382 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4383 & *expdis/(aux*forcon(i)**2)
4384 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4385 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4386 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4387 else if (irestr_type(i).eq.2) then
4388 c Quartic restraints
4389 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4390 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4391 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4392 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4393 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4395 c Quadratic restraints
4397 C Get the force constant corresponding to this distance.
4399 C Calculate the contribution to energy.
4400 ehpb=ehpb+0.5d0*waga*rdis*rdis
4401 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4402 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4403 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4405 C Evaluate gradient.
4409 c Calculate Cartesian gradient
4411 ggg(j)=fac*(c(j,jj)-c(j,ii))
4413 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4414 C If this is a SC-SC distance, we need to calculate the contributions to the
4415 C Cartesian gradient in the SC vectors (ghpbx).
4418 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4423 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4427 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4428 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4434 C--------------------------------------------------------------------------
4435 subroutine ssbond_ene(i,j,eij)
4437 C Calculate the distance and angle dependent SS-bond potential energy
4438 C using a free-energy function derived based on RHF/6-31G** ab initio
4439 C calculations of diethyl disulfide.
4441 C A. Liwo and U. Kozlowska, 11/24/03
4443 implicit real*8 (a-h,o-z)
4444 include 'DIMENSIONS'
4445 include 'COMMON.SBRIDGE'
4446 include 'COMMON.CHAIN'
4447 include 'COMMON.DERIV'
4448 include 'COMMON.LOCAL'
4449 include 'COMMON.INTERACT'
4450 include 'COMMON.VAR'
4451 include 'COMMON.IOUNITS'
4452 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4453 itypi=iabs(itype(i))
4457 dxi=dc_norm(1,nres+i)
4458 dyi=dc_norm(2,nres+i)
4459 dzi=dc_norm(3,nres+i)
4460 dsci_inv=dsc_inv(itypi)
4461 itypj=iabs(itype(j))
4462 dscj_inv=dsc_inv(itypj)
4466 dxj=dc_norm(1,nres+j)
4467 dyj=dc_norm(2,nres+j)
4468 dzj=dc_norm(3,nres+j)
4469 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4474 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4475 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4476 om12=dxi*dxj+dyi*dyj+dzi*dzj
4478 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4479 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4485 deltat12=om2-om1+2.0d0
4487 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4488 & +akct*deltad*deltat12
4489 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4490 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4491 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4492 c & " deltat12",deltat12," eij",eij
4493 ed=2*akcm*deltad+akct*deltat12
4495 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4496 eom1=-2*akth*deltat1-pom1-om2*pom2
4497 eom2= 2*akth*deltat2+pom1-om1*pom2
4500 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4503 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4504 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4505 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4506 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4509 C Calculate the components of the gradient in DC and X
4513 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4518 C--------------------------------------------------------------------------
4519 subroutine ebond(estr)
4521 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4523 implicit real*8 (a-h,o-z)
4524 include 'DIMENSIONS'
4525 include 'COMMON.LOCAL'
4526 include 'COMMON.GEO'
4527 include 'COMMON.INTERACT'
4528 include 'COMMON.DERIV'
4529 include 'COMMON.VAR'
4530 include 'COMMON.CHAIN'
4531 include 'COMMON.IOUNITS'
4532 include 'COMMON.NAMES'
4533 include 'COMMON.FFIELD'
4534 include 'COMMON.CONTROL'
4535 double precision u(3),ud(3)
4538 c write (iout,*) "distchainmax",distchainmax
4541 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
4542 diff = vbld(i)-vbldp0
4544 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4545 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4547 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4548 C & *dc(j,i-1)/vbld(i)
4550 C if (energy_dec) write(iout,*)
4551 C & "estr1",i,vbld(i),distchainmax,
4552 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4554 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4555 diff = vbld(i)-vbldpDUM
4556 C write(iout,*) i,diff
4558 diff = vbld(i)-vbldp0
4559 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4562 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4563 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4566 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4569 C write (iout,'(a7,i5,4f7.3)')
4570 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4572 estr=0.5d0*AKP*estr+estr1
4574 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4578 if (iti.ne.10 .and. iti.ne.ntyp1) then
4581 diff=vbld(i+nres)-vbldsc0(1,iti)
4582 if (energy_dec) write (iout,*)
4583 & i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4584 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4585 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4587 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4591 diff=vbld(i+nres)-vbldsc0(j,iti)
4592 ud(j)=aksc(j,iti)*diff
4593 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4607 uprod2=uprod2*u(k)*u(k)
4611 usumsqder=usumsqder+ud(j)*uprod2
4613 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4614 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4615 estr=estr+uprod/usum
4617 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4625 C--------------------------------------------------------------------------
4626 subroutine ebend(etheta,ethetacnstr)
4628 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4629 C angles gamma and its derivatives in consecutive thetas and gammas.
4631 implicit real*8 (a-h,o-z)
4632 include 'DIMENSIONS'
4633 include 'COMMON.LOCAL'
4634 include 'COMMON.GEO'
4635 include 'COMMON.INTERACT'
4636 include 'COMMON.DERIV'
4637 include 'COMMON.VAR'
4638 include 'COMMON.CHAIN'
4639 include 'COMMON.IOUNITS'
4640 include 'COMMON.NAMES'
4641 include 'COMMON.FFIELD'
4642 include 'COMMON.TORCNSTR'
4643 common /calcthet/ term1,term2,termm,diffak,ratak,
4644 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4645 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4646 double precision y(2),z(2)
4648 c time11=dexp(-2*time)
4651 c write (iout,*) "nres",nres
4652 c write (*,'(a,i2)') 'EBEND ICG=',icg
4653 c write (iout,*) ithet_start,ithet_end
4654 do i=ithet_start,ithet_end
4655 C if (itype(i-1).eq.ntyp1) cycle
4657 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4658 & .or.itype(i).eq.ntyp1) cycle
4659 C Zero the energy function and its derivative at 0 or pi.
4660 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4662 ichir1=isign(1,itype(i-2))
4663 ichir2=isign(1,itype(i))
4664 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4665 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4666 if (itype(i-1).eq.10) then
4667 itype1=isign(10,itype(i-2))
4668 ichir11=isign(1,itype(i-2))
4669 ichir12=isign(1,itype(i-2))
4670 itype2=isign(10,itype(i))
4671 ichir21=isign(1,itype(i))
4672 ichir22=isign(1,itype(i))
4679 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4683 c call proc_proc(phii,icrc)
4684 if (icrc.eq.1) phii=150.0
4695 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4699 c call proc_proc(phii1,icrc)
4700 if (icrc.eq.1) phii1=150.0
4712 C Calculate the "mean" value of theta from the part of the distribution
4713 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4714 C In following comments this theta will be referred to as t_c.
4715 thet_pred_mean=0.0d0
4717 athetk=athet(k,it,ichir1,ichir2)
4718 bthetk=bthet(k,it,ichir1,ichir2)
4720 athetk=athet(k,itype1,ichir11,ichir12)
4721 bthetk=bthet(k,itype2,ichir21,ichir22)
4723 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4725 c write (iout,*) "thet_pred_mean",thet_pred_mean
4726 dthett=thet_pred_mean*ssd
4727 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4728 c write (iout,*) "thet_pred_mean",thet_pred_mean
4729 C Derivatives of the "mean" values in gamma1 and gamma2.
4730 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4731 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4732 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4733 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4735 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4736 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4737 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4738 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4740 if (theta(i).gt.pi-delta) then
4741 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4743 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4744 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4745 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4747 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4749 else if (theta(i).lt.delta) then
4750 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4751 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4752 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4754 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4755 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4758 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4761 etheta=etheta+ethetai
4762 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4763 c & 'ebend',i,ethetai,theta(i),itype(i)
4764 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4765 c & rad2deg*phii,rad2deg*phii1,ethetai
4766 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4767 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4768 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4772 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4773 do i=1,ntheta_constr
4774 itheta=itheta_constr(i)
4775 thetiii=theta(itheta)
4776 difi=pinorm(thetiii-theta_constr0(i))
4777 if (difi.gt.theta_drange(i)) then
4778 difi=difi-theta_drange(i)
4779 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4780 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4781 & +for_thet_constr(i)*difi**3
4782 else if (difi.lt.-drange(i)) then
4784 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4785 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4786 & +for_thet_constr(i)*difi**3
4790 C if (energy_dec) then
4791 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4792 C & i,itheta,rad2deg*thetiii,
4793 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4794 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4795 C & gloc(itheta+nphi-2,icg)
4798 C Ufff.... We've done all this!!!
4801 C---------------------------------------------------------------------------
4802 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4804 implicit real*8 (a-h,o-z)
4805 include 'DIMENSIONS'
4806 include 'COMMON.LOCAL'
4807 include 'COMMON.IOUNITS'
4808 common /calcthet/ term1,term2,termm,diffak,ratak,
4809 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4810 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4811 C Calculate the contributions to both Gaussian lobes.
4812 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4813 C The "polynomial part" of the "standard deviation" of this part of
4817 sig=sig*thet_pred_mean+polthet(j,it)
4819 C Derivative of the "interior part" of the "standard deviation of the"
4820 C gamma-dependent Gaussian lobe in t_c.
4821 sigtc=3*polthet(3,it)
4823 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4826 C Set the parameters of both Gaussian lobes of the distribution.
4827 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4828 fac=sig*sig+sigc0(it)
4831 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4832 sigsqtc=-4.0D0*sigcsq*sigtc
4833 c print *,i,sig,sigtc,sigsqtc
4834 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4835 sigtc=-sigtc/(fac*fac)
4836 C Following variable is sigma(t_c)**(-2)
4837 sigcsq=sigcsq*sigcsq
4839 sig0inv=1.0D0/sig0i**2
4840 delthec=thetai-thet_pred_mean
4841 delthe0=thetai-theta0i
4842 term1=-0.5D0*sigcsq*delthec*delthec
4843 term2=-0.5D0*sig0inv*delthe0*delthe0
4844 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4845 C NaNs in taking the logarithm. We extract the largest exponent which is added
4846 C to the energy (this being the log of the distribution) at the end of energy
4847 C term evaluation for this virtual-bond angle.
4848 if (term1.gt.term2) then
4850 term2=dexp(term2-termm)
4854 term1=dexp(term1-termm)
4857 C The ratio between the gamma-independent and gamma-dependent lobes of
4858 C the distribution is a Gaussian function of thet_pred_mean too.
4859 diffak=gthet(2,it)-thet_pred_mean
4860 ratak=diffak/gthet(3,it)**2
4861 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4862 C Let's differentiate it in thet_pred_mean NOW.
4864 C Now put together the distribution terms to make complete distribution.
4865 termexp=term1+ak*term2
4866 termpre=sigc+ak*sig0i
4867 C Contribution of the bending energy from this theta is just the -log of
4868 C the sum of the contributions from the two lobes and the pre-exponential
4869 C factor. Simple enough, isn't it?
4870 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4871 C NOW the derivatives!!!
4872 C 6/6/97 Take into account the deformation.
4873 E_theta=(delthec*sigcsq*term1
4874 & +ak*delthe0*sig0inv*term2)/termexp
4875 E_tc=((sigtc+aktc*sig0i)/termpre
4876 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4877 & aktc*term2)/termexp)
4880 c-----------------------------------------------------------------------------
4881 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4882 implicit real*8 (a-h,o-z)
4883 include 'DIMENSIONS'
4884 include 'COMMON.LOCAL'
4885 include 'COMMON.IOUNITS'
4886 common /calcthet/ term1,term2,termm,diffak,ratak,
4887 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4888 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4889 delthec=thetai-thet_pred_mean
4890 delthe0=thetai-theta0i
4891 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4892 t3 = thetai-thet_pred_mean
4896 t14 = t12+t6*sigsqtc
4898 t21 = thetai-theta0i
4904 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4905 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4906 & *(-t12*t9-ak*sig0inv*t27)
4910 C--------------------------------------------------------------------------
4911 subroutine ebend(etheta)
4913 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4914 C angles gamma and its derivatives in consecutive thetas and gammas.
4915 C ab initio-derived potentials from
4916 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4918 implicit real*8 (a-h,o-z)
4919 include 'DIMENSIONS'
4920 include 'COMMON.LOCAL'
4921 include 'COMMON.GEO'
4922 include 'COMMON.INTERACT'
4923 include 'COMMON.DERIV'
4924 include 'COMMON.VAR'
4925 include 'COMMON.CHAIN'
4926 include 'COMMON.IOUNITS'
4927 include 'COMMON.NAMES'
4928 include 'COMMON.FFIELD'
4929 include 'COMMON.CONTROL'
4930 include 'COMMON.TORCNSTR'
4931 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4932 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4933 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4934 & sinph1ph2(maxdouble,maxdouble)
4935 logical lprn /.false./, lprn1 /.false./
4937 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4938 do i=ithet_start,ithet_end
4940 C if (itype(i-1).eq.ntyp1) cycle
4942 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4943 & .or.itype(i).eq.ntyp1) cycle
4944 if (iabs(itype(i+1)).eq.20) iblock=2
4945 if (iabs(itype(i+1)).ne.20) iblock=1
4949 theti2=0.5d0*theta(i)
4950 ityp2=ithetyp((itype(i-1)))
4952 coskt(k)=dcos(k*theti2)
4953 sinkt(k)=dsin(k*theti2)
4963 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4966 if (phii.ne.phii) phii=150.0
4970 ityp1=ithetyp((itype(i-2)))
4972 cosph1(k)=dcos(k*phii)
4973 sinph1(k)=dsin(k*phii)
4979 ityp1=ithetyp((itype(i-2)))
4984 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4987 if (phii1.ne.phii1) phii1=150.0
4992 ityp3=ithetyp((itype(i)))
4994 cosph2(k)=dcos(k*phii1)
4995 sinph2(k)=dsin(k*phii1)
5000 ityp3=ithetyp((itype(i)))
5006 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5007 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5009 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5012 ccl=cosph1(l)*cosph2(k-l)
5013 ssl=sinph1(l)*sinph2(k-l)
5014 scl=sinph1(l)*cosph2(k-l)
5015 csl=cosph1(l)*sinph2(k-l)
5016 cosph1ph2(l,k)=ccl-ssl
5017 cosph1ph2(k,l)=ccl+ssl
5018 sinph1ph2(l,k)=scl+csl
5019 sinph1ph2(k,l)=scl-csl
5023 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5024 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5025 write (iout,*) "coskt and sinkt"
5027 write (iout,*) k,coskt(k),sinkt(k)
5031 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5032 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5035 & write (iout,*) "k",k,"
5036 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5037 & " ethetai",ethetai
5040 write (iout,*) "cosph and sinph"
5042 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5044 write (iout,*) "cosph1ph2 and sinph2ph2"
5047 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5048 & sinph1ph2(l,k),sinph1ph2(k,l)
5051 write(iout,*) "ethetai",ethetai
5055 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5056 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5057 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5058 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5059 ethetai=ethetai+sinkt(m)*aux
5060 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5061 dephii=dephii+k*sinkt(m)*(
5062 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5063 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5064 dephii1=dephii1+k*sinkt(m)*(
5065 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5066 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5068 & write (iout,*) "m",m," k",k," bbthet",
5069 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5070 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5071 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5072 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5076 & write(iout,*) "ethetai",ethetai
5080 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5081 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5082 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5083 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5084 ethetai=ethetai+sinkt(m)*aux
5085 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5086 dephii=dephii+l*sinkt(m)*(
5087 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5088 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5089 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5090 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5091 dephii1=dephii1+(k-l)*sinkt(m)*(
5092 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5093 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5094 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5095 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5097 write (iout,*) "m",m," k",k," l",l," ffthet",
5098 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5099 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5100 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5101 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5102 & " ethetai",ethetai
5103 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5104 & cosph1ph2(k,l)*sinkt(m),
5105 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5111 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5112 & i,theta(i)*rad2deg,phii*rad2deg,
5113 & phii1*rad2deg,ethetai
5114 etheta=etheta+ethetai
5115 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5116 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5117 c gloc(nphi+i-2,icg)=wang*dethetai
5118 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5124 c-----------------------------------------------------------------------------
5125 subroutine esc(escloc)
5126 C Calculate the local energy of a side chain and its derivatives in the
5127 C corresponding virtual-bond valence angles THETA and the spherical angles
5129 implicit real*8 (a-h,o-z)
5130 include 'DIMENSIONS'
5131 include 'COMMON.GEO'
5132 include 'COMMON.LOCAL'
5133 include 'COMMON.VAR'
5134 include 'COMMON.INTERACT'
5135 include 'COMMON.DERIV'
5136 include 'COMMON.CHAIN'
5137 include 'COMMON.IOUNITS'
5138 include 'COMMON.NAMES'
5139 include 'COMMON.FFIELD'
5140 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5141 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5142 common /sccalc/ time11,time12,time112,theti,it,nlobit
5145 C write (iout,*) 'ESC'
5146 do i=loc_start,loc_end
5148 if (it.eq.ntyp1) cycle
5149 if (it.eq.10) goto 1
5150 nlobit=nlob(iabs(it))
5151 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5152 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5153 theti=theta(i+1)-pipol
5157 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5159 if (x(2).gt.pi-delta) then
5163 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5165 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5166 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5168 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5169 & ddersc0(1),dersc(1))
5170 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5171 & ddersc0(3),dersc(3))
5173 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5175 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5176 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5177 & dersc0(2),esclocbi,dersc02)
5178 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5180 call splinthet(x(2),0.5d0*delta,ss,ssd)
5185 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5187 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5188 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5190 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5192 c write (iout,*) escloci
5193 else if (x(2).lt.delta) then
5197 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5199 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5200 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5202 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5203 & ddersc0(1),dersc(1))
5204 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5205 & ddersc0(3),dersc(3))
5207 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5209 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5210 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5211 & dersc0(2),esclocbi,dersc02)
5212 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5217 call splinthet(x(2),0.5d0*delta,ss,ssd)
5219 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5221 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5222 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5224 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5225 C write (iout,*) 'i=',i, escloci
5227 call enesc(x,escloci,dersc,ddummy,.false.)
5230 escloc=escloc+escloci
5231 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5232 write (iout,'(a6,i5,0pf7.3)')
5233 & 'escloc',i,escloci
5235 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5237 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5238 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5243 C---------------------------------------------------------------------------
5244 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5245 implicit real*8 (a-h,o-z)
5246 include 'DIMENSIONS'
5247 include 'COMMON.GEO'
5248 include 'COMMON.LOCAL'
5249 include 'COMMON.IOUNITS'
5250 common /sccalc/ time11,time12,time112,theti,it,nlobit
5251 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5252 double precision contr(maxlob,-1:1)
5254 c write (iout,*) 'it=',it,' nlobit=',nlobit
5258 if (mixed) ddersc(j)=0.0d0
5262 C Because of periodicity of the dependence of the SC energy in omega we have
5263 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5264 C To avoid underflows, first compute & store the exponents.
5272 z(k)=x(k)-censc(k,j,it)
5277 Axk=Axk+gaussc(l,k,j,it)*z(l)
5283 expfac=expfac+Ax(k,j,iii)*z(k)
5291 C As in the case of ebend, we want to avoid underflows in exponentiation and
5292 C subsequent NaNs and INFs in energy calculation.
5293 C Find the largest exponent
5297 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5301 cd print *,'it=',it,' emin=',emin
5303 C Compute the contribution to SC energy and derivatives
5307 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5308 cd print *,'j=',j,' expfac=',expfac
5309 escloc_i=escloc_i+expfac
5311 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5315 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5316 & +gaussc(k,2,j,it))*expfac
5323 dersc(1)=dersc(1)/cos(theti)**2
5324 ddersc(1)=ddersc(1)/cos(theti)**2
5327 escloci=-(dlog(escloc_i)-emin)
5329 dersc(j)=dersc(j)/escloc_i
5333 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5338 C------------------------------------------------------------------------------
5339 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5340 implicit real*8 (a-h,o-z)
5341 include 'DIMENSIONS'
5342 include 'COMMON.GEO'
5343 include 'COMMON.LOCAL'
5344 include 'COMMON.IOUNITS'
5345 common /sccalc/ time11,time12,time112,theti,it,nlobit
5346 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5347 double precision contr(maxlob)
5358 z(k)=x(k)-censc(k,j,it)
5364 Axk=Axk+gaussc(l,k,j,it)*z(l)
5370 expfac=expfac+Ax(k,j)*z(k)
5375 C As in the case of ebend, we want to avoid underflows in exponentiation and
5376 C subsequent NaNs and INFs in energy calculation.
5377 C Find the largest exponent
5380 if (emin.gt.contr(j)) emin=contr(j)
5384 C Compute the contribution to SC energy and derivatives
5388 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5389 escloc_i=escloc_i+expfac
5391 dersc(k)=dersc(k)+Ax(k,j)*expfac
5393 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5394 & +gaussc(1,2,j,it))*expfac
5398 dersc(1)=dersc(1)/cos(theti)**2
5399 dersc12=dersc12/cos(theti)**2
5400 escloci=-(dlog(escloc_i)-emin)
5402 dersc(j)=dersc(j)/escloc_i
5404 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5408 c----------------------------------------------------------------------------------
5409 subroutine esc(escloc)
5410 C Calculate the local energy of a side chain and its derivatives in the
5411 C corresponding virtual-bond valence angles THETA and the spherical angles
5412 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5413 C added by Urszula Kozlowska. 07/11/2007
5415 implicit real*8 (a-h,o-z)
5416 include 'DIMENSIONS'
5417 include 'COMMON.GEO'
5418 include 'COMMON.LOCAL'
5419 include 'COMMON.VAR'
5420 include 'COMMON.SCROT'
5421 include 'COMMON.INTERACT'
5422 include 'COMMON.DERIV'
5423 include 'COMMON.CHAIN'
5424 include 'COMMON.IOUNITS'
5425 include 'COMMON.NAMES'
5426 include 'COMMON.FFIELD'
5427 include 'COMMON.CONTROL'
5428 include 'COMMON.VECTORS'
5429 double precision x_prime(3),y_prime(3),z_prime(3)
5430 & , sumene,dsc_i,dp2_i,x(65),
5431 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5432 & de_dxx,de_dyy,de_dzz,de_dt
5433 double precision s1_t,s1_6_t,s2_t,s2_6_t
5435 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5436 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5437 & dt_dCi(3),dt_dCi1(3)
5438 common /sccalc/ time11,time12,time112,theti,it,nlobit
5441 do i=loc_start,loc_end
5442 if (itype(i).eq.ntyp1) cycle
5443 costtab(i+1) =dcos(theta(i+1))
5444 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5445 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5446 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5447 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5448 cosfac=dsqrt(cosfac2)
5449 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5450 sinfac=dsqrt(sinfac2)
5452 if (it.eq.10) goto 1
5454 C Compute the axes of tghe local cartesian coordinates system; store in
5455 c x_prime, y_prime and z_prime
5462 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5463 C & dc_norm(3,i+nres)
5465 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5466 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5469 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5472 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5473 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5474 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5475 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5476 c & " xy",scalar(x_prime(1),y_prime(1)),
5477 c & " xz",scalar(x_prime(1),z_prime(1)),
5478 c & " yy",scalar(y_prime(1),y_prime(1)),
5479 c & " yz",scalar(y_prime(1),z_prime(1)),
5480 c & " zz",scalar(z_prime(1),z_prime(1))
5482 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5483 C to local coordinate system. Store in xx, yy, zz.
5489 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5490 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5491 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5498 C Compute the energy of the ith side cbain
5500 c write (2,*) "xx",xx," yy",yy," zz",zz
5503 x(j) = sc_parmin(j,it)
5506 Cc diagnostics - remove later
5508 yy1 = dsin(alph(2))*dcos(omeg(2))
5509 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5510 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5511 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5513 C," --- ", xx_w,yy_w,zz_w
5516 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5517 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5519 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5520 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5522 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5523 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5524 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5525 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5526 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5528 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5529 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5530 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5531 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5532 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5534 dsc_i = 0.743d0+x(61)
5536 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5537 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5538 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5539 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5540 s1=(1+x(63))/(0.1d0 + dscp1)
5541 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5542 s2=(1+x(65))/(0.1d0 + dscp2)
5543 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5544 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5545 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5546 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5548 c & dscp1,dscp2,sumene
5549 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5550 escloc = escloc + sumene
5551 c write (2,*) "escloc",escloc
5552 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5554 if (.not. calc_grad) goto 1
5557 C This section to check the numerical derivatives of the energy of ith side
5558 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5559 C #define DEBUG in the code to turn it on.
5561 write (2,*) "sumene =",sumene
5565 write (2,*) xx,yy,zz
5566 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5567 de_dxx_num=(sumenep-sumene)/aincr
5569 write (2,*) "xx+ sumene from enesc=",sumenep
5572 write (2,*) xx,yy,zz
5573 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5574 de_dyy_num=(sumenep-sumene)/aincr
5576 write (2,*) "yy+ sumene from enesc=",sumenep
5579 write (2,*) xx,yy,zz
5580 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5581 de_dzz_num=(sumenep-sumene)/aincr
5583 write (2,*) "zz+ sumene from enesc=",sumenep
5584 costsave=cost2tab(i+1)
5585 sintsave=sint2tab(i+1)
5586 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5587 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5588 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5589 de_dt_num=(sumenep-sumene)/aincr
5590 write (2,*) " t+ sumene from enesc=",sumenep
5591 cost2tab(i+1)=costsave
5592 sint2tab(i+1)=sintsave
5593 C End of diagnostics section.
5596 C Compute the gradient of esc
5598 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5599 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5600 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5601 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5602 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5603 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5604 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5605 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5606 pom1=(sumene3*sint2tab(i+1)+sumene1)
5607 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5608 pom2=(sumene4*cost2tab(i+1)+sumene2)
5609 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5610 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5611 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5612 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5614 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5615 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5616 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5618 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5619 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5620 & +(pom1+pom2)*pom_dx
5622 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5625 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5626 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5627 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5629 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5630 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5631 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5632 & +x(59)*zz**2 +x(60)*xx*zz
5633 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5634 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5635 & +(pom1-pom2)*pom_dy
5637 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5640 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5641 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5642 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5643 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5644 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5645 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5646 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5647 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5649 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5652 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5653 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5654 & +pom1*pom_dt1+pom2*pom_dt2
5656 write(2,*), "de_dt = ", de_dt,de_dt_num
5660 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5661 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5662 cosfac2xx=cosfac2*xx
5663 sinfac2yy=sinfac2*yy
5665 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5667 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5669 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5670 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5671 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5672 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5673 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5674 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5675 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5676 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5677 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5678 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5682 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5683 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5684 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5685 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5688 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5689 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5690 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5692 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5693 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5697 dXX_Ctab(k,i)=dXX_Ci(k)
5698 dXX_C1tab(k,i)=dXX_Ci1(k)
5699 dYY_Ctab(k,i)=dYY_Ci(k)
5700 dYY_C1tab(k,i)=dYY_Ci1(k)
5701 dZZ_Ctab(k,i)=dZZ_Ci(k)
5702 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5703 dXX_XYZtab(k,i)=dXX_XYZ(k)
5704 dYY_XYZtab(k,i)=dYY_XYZ(k)
5705 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5709 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5710 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5711 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5712 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5713 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5715 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5716 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5717 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5718 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5719 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5720 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5721 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5722 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5724 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5725 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5727 C to check gradient call subroutine check_grad
5734 c------------------------------------------------------------------------------
5735 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5737 C This procedure calculates two-body contact function g(rij) and its derivative:
5740 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5743 C where x=(rij-r0ij)/delta
5745 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5748 double precision rij,r0ij,eps0ij,fcont,fprimcont
5749 double precision x,x2,x4,delta
5753 if (x.lt.-1.0D0) then
5756 else if (x.le.1.0D0) then
5759 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5760 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5767 c------------------------------------------------------------------------------
5768 subroutine splinthet(theti,delta,ss,ssder)
5769 implicit real*8 (a-h,o-z)
5770 include 'DIMENSIONS'
5771 include 'COMMON.VAR'
5772 include 'COMMON.GEO'
5775 if (theti.gt.pipol) then
5776 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5778 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5783 c------------------------------------------------------------------------------
5784 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5786 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5787 double precision ksi,ksi2,ksi3,a1,a2,a3
5788 a1=fprim0*delta/(f1-f0)
5794 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5795 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5798 c------------------------------------------------------------------------------
5799 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5801 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5802 double precision ksi,ksi2,ksi3,a1,a2,a3
5807 a2=3*(f1x-f0x)-2*fprim0x*delta
5808 a3=fprim0x*delta-2*(f1x-f0x)
5809 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5812 C-----------------------------------------------------------------------------
5814 C-----------------------------------------------------------------------------
5815 subroutine etor(etors,fact)
5816 implicit real*8 (a-h,o-z)
5817 include 'DIMENSIONS'
5818 include 'COMMON.VAR'
5819 include 'COMMON.GEO'
5820 include 'COMMON.LOCAL'
5821 include 'COMMON.TORSION'
5822 include 'COMMON.INTERACT'
5823 include 'COMMON.DERIV'
5824 include 'COMMON.CHAIN'
5825 include 'COMMON.NAMES'
5826 include 'COMMON.IOUNITS'
5827 include 'COMMON.FFIELD'
5828 include 'COMMON.TORCNSTR'
5830 C Set lprn=.true. for debugging
5834 do i=iphi_start,iphi_end
5835 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5836 & .or. itype(i).eq.ntyp1) cycle
5837 itori=itortyp(itype(i-2))
5838 itori1=itortyp(itype(i-1))
5841 C Proline-Proline pair is a special case...
5842 if (itori.eq.3 .and. itori1.eq.3) then
5843 if (phii.gt.-dwapi3) then
5845 fac=1.0D0/(1.0D0-cosphi)
5846 etorsi=v1(1,3,3)*fac
5847 etorsi=etorsi+etorsi
5848 etors=etors+etorsi-v1(1,3,3)
5849 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5852 v1ij=v1(j+1,itori,itori1)
5853 v2ij=v2(j+1,itori,itori1)
5856 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5857 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5861 v1ij=v1(j,itori,itori1)
5862 v2ij=v2(j,itori,itori1)
5865 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5866 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5870 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5871 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5872 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5873 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5874 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5878 c------------------------------------------------------------------------------
5880 subroutine etor(etors,fact)
5881 implicit real*8 (a-h,o-z)
5882 include 'DIMENSIONS'
5883 include 'COMMON.VAR'
5884 include 'COMMON.GEO'
5885 include 'COMMON.LOCAL'
5886 include 'COMMON.TORSION'
5887 include 'COMMON.INTERACT'
5888 include 'COMMON.DERIV'
5889 include 'COMMON.CHAIN'
5890 include 'COMMON.NAMES'
5891 include 'COMMON.IOUNITS'
5892 include 'COMMON.FFIELD'
5893 include 'COMMON.TORCNSTR'
5895 C Set lprn=.true. for debugging
5899 do i=iphi_start,iphi_end
5901 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5902 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5903 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5904 C & .or. itype(i).eq.ntyp1) cycle
5905 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5906 if (iabs(itype(i)).eq.20) then
5911 itori=itortyp(itype(i-2))
5912 itori1=itortyp(itype(i-1))
5915 C Regular cosine and sine terms
5916 do j=1,nterm(itori,itori1,iblock)
5917 v1ij=v1(j,itori,itori1,iblock)
5918 v2ij=v2(j,itori,itori1,iblock)
5921 etors=etors+v1ij*cosphi+v2ij*sinphi
5922 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5926 C E = SUM ----------------------------------- - v1
5927 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5929 cosphi=dcos(0.5d0*phii)
5930 sinphi=dsin(0.5d0*phii)
5931 do j=1,nlor(itori,itori1,iblock)
5932 vl1ij=vlor1(j,itori,itori1)
5933 vl2ij=vlor2(j,itori,itori1)
5934 vl3ij=vlor3(j,itori,itori1)
5935 pom=vl2ij*cosphi+vl3ij*sinphi
5936 pom1=1.0d0/(pom*pom+1.0d0)
5937 etors=etors+vl1ij*pom1
5938 c if (energy_dec) etors_ii=etors_ii+
5941 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5943 C Subtract the constant term
5944 etors=etors-v0(itori,itori1,iblock)
5946 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5947 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5948 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5949 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5950 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5955 c----------------------------------------------------------------------------
5956 subroutine etor_d(etors_d,fact2)
5957 C 6/23/01 Compute double torsional energy
5958 implicit real*8 (a-h,o-z)
5959 include 'DIMENSIONS'
5960 include 'COMMON.VAR'
5961 include 'COMMON.GEO'
5962 include 'COMMON.LOCAL'
5963 include 'COMMON.TORSION'
5964 include 'COMMON.INTERACT'
5965 include 'COMMON.DERIV'
5966 include 'COMMON.CHAIN'
5967 include 'COMMON.NAMES'
5968 include 'COMMON.IOUNITS'
5969 include 'COMMON.FFIELD'
5970 include 'COMMON.TORCNSTR'
5972 C Set lprn=.true. for debugging
5976 do i=iphi_start,iphi_end-1
5978 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5979 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5980 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5981 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5982 & (itype(i+1).eq.ntyp1)) cycle
5983 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5985 itori=itortyp(itype(i-2))
5986 itori1=itortyp(itype(i-1))
5987 itori2=itortyp(itype(i))
5993 if (iabs(itype(i+1)).eq.20) iblock=2
5994 C Regular cosine and sine terms
5995 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5996 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5997 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5998 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5999 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6000 cosphi1=dcos(j*phii)
6001 sinphi1=dsin(j*phii)
6002 cosphi2=dcos(j*phii1)
6003 sinphi2=dsin(j*phii1)
6004 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6005 & v2cij*cosphi2+v2sij*sinphi2
6006 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6007 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6009 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6011 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6012 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6013 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6014 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6015 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6016 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6017 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6018 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6019 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6020 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6021 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6022 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6023 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6024 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6027 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6028 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6034 c---------------------------------------------------------------------------
6035 C The rigorous attempt to derive energy function
6036 subroutine etor_kcc(etors,fact)
6037 implicit real*8 (a-h,o-z)
6038 include 'DIMENSIONS'
6039 include 'COMMON.VAR'
6040 include 'COMMON.GEO'
6041 include 'COMMON.LOCAL'
6042 include 'COMMON.TORSION'
6043 include 'COMMON.INTERACT'
6044 include 'COMMON.DERIV'
6045 include 'COMMON.CHAIN'
6046 include 'COMMON.NAMES'
6047 include 'COMMON.IOUNITS'
6048 include 'COMMON.FFIELD'
6049 include 'COMMON.TORCNSTR'
6050 include 'COMMON.CONTROL'
6051 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
6053 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
6054 C Set lprn=.true. for debugging
6057 C print *,"wchodze kcc"
6058 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
6060 do i=iphi_start,iphi_end
6061 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6062 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6063 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6064 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6065 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6066 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6067 itori=itortyp(itype(i-2))
6068 itori1=itortyp(itype(i-1))
6073 C to avoid multiple devision by 2
6074 c theti22=0.5d0*theta(i)
6075 C theta 12 is the theta_1 /2
6076 C theta 22 is theta_2 /2
6077 c theti12=0.5d0*theta(i-1)
6078 C and appropriate sinus function
6079 sinthet1=dsin(theta(i-1))
6080 sinthet2=dsin(theta(i))
6081 costhet1=dcos(theta(i-1))
6082 costhet2=dcos(theta(i))
6083 C to speed up lets store its mutliplication
6084 sint1t2=sinthet2*sinthet1
6086 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
6087 C +d_n*sin(n*gamma)) *
6088 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
6089 C we have two sum 1) Non-Chebyshev which is with n and gamma
6090 nval=nterm_kcc_Tb(itori,itori1)
6096 c1(j)=c1(j-1)*costhet1
6097 c2(j)=c2(j-1)*costhet2
6100 do j=1,nterm_kcc(itori,itori1)
6104 sint1t2n=sint1t2n*sint1t2
6110 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6111 gradvalct1=gradvalct1+
6112 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6113 gradvalct2=gradvalct2+
6114 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6117 gradvalct1=-gradvalct1*sinthet1
6118 gradvalct2=-gradvalct2*sinthet2
6124 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6125 gradvalst1=gradvalst1+
6126 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6127 gradvalst2=gradvalst2+
6128 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6131 gradvalst1=-gradvalst1*sinthet1
6132 gradvalst2=-gradvalst2*sinthet2
6133 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6134 C glocig is the gradient local i site in gamma
6135 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6136 C now gradient over theta_1
6137 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6138 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6139 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6140 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6143 C derivative over gamma
6144 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6145 C derivative over theta1
6146 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6147 C now derivative over theta2
6148 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6150 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6151 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6155 c---------------------------------------------------------------------------------------------
6156 subroutine etor_constr(edihcnstr)
6157 implicit real*8 (a-h,o-z)
6158 include 'DIMENSIONS'
6159 include 'COMMON.VAR'
6160 include 'COMMON.GEO'
6161 include 'COMMON.LOCAL'
6162 include 'COMMON.TORSION'
6163 include 'COMMON.INTERACT'
6164 include 'COMMON.DERIV'
6165 include 'COMMON.CHAIN'
6166 include 'COMMON.NAMES'
6167 include 'COMMON.IOUNITS'
6168 include 'COMMON.FFIELD'
6169 include 'COMMON.TORCNSTR'
6170 include 'COMMON.CONTROL'
6171 ! 6/20/98 - dihedral angle constraints
6173 c do i=1,ndih_constr
6174 c write (iout,*) "idihconstr_start",idihconstr_start,
6175 c & " idihconstr_end",idihconstr_end
6176 if (raw_psipred) then
6177 do i=idihconstr_start,idihconstr_end
6178 itori=idih_constr(i)
6180 gaudih_i=vpsipred(1,i)
6184 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6185 dexpcos_i=dexp(-cos_i*cos_i)
6186 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6187 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6188 & *cos_i*dexpcos_i/s**2
6190 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6191 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6193 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6194 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6195 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6196 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6197 & -wdihc*dlog(gaudih_i)
6200 do i=idihconstr_start,idihconstr_end
6201 itori=idih_constr(i)
6203 difi=pinorm(phii-phi0(i))
6204 if (difi.gt.drange(i)) then
6206 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6207 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6208 else if (difi.lt.-drange(i)) then
6210 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6211 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6219 c----------------------------------------------------------------------------
6220 C The rigorous attempt to derive energy function
6221 subroutine ebend_kcc(etheta)
6223 implicit real*8 (a-h,o-z)
6224 include 'DIMENSIONS'
6225 include 'COMMON.VAR'
6226 include 'COMMON.GEO'
6227 include 'COMMON.LOCAL'
6228 include 'COMMON.TORSION'
6229 include 'COMMON.INTERACT'
6230 include 'COMMON.DERIV'
6231 include 'COMMON.CHAIN'
6232 include 'COMMON.NAMES'
6233 include 'COMMON.IOUNITS'
6234 include 'COMMON.FFIELD'
6235 include 'COMMON.TORCNSTR'
6236 include 'COMMON.CONTROL'
6238 double precision thybt1(maxang_kcc)
6239 C Set lprn=.true. for debugging
6242 C print *,"wchodze kcc"
6243 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6245 do i=ithet_start,ithet_end
6246 c print *,i,itype(i-1),itype(i),itype(i-2)
6247 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6248 & .or.itype(i).eq.ntyp1) cycle
6249 iti=iabs(itortyp(itype(i-1)))
6250 sinthet=dsin(theta(i))
6251 costhet=dcos(theta(i))
6252 do j=1,nbend_kcc_Tb(iti)
6253 thybt1(j)=v1bend_chyb(j,iti)
6255 sumth1thyb=v1bend_chyb(0,iti)+
6256 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6257 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6259 ihelp=nbend_kcc_Tb(iti)-1
6260 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6261 etheta=etheta+sumth1thyb
6262 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6263 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6267 c-------------------------------------------------------------------------------------
6268 subroutine etheta_constr(ethetacnstr)
6270 implicit real*8 (a-h,o-z)
6271 include 'DIMENSIONS'
6272 include 'COMMON.VAR'
6273 include 'COMMON.GEO'
6274 include 'COMMON.LOCAL'
6275 include 'COMMON.TORSION'
6276 include 'COMMON.INTERACT'
6277 include 'COMMON.DERIV'
6278 include 'COMMON.CHAIN'
6279 include 'COMMON.NAMES'
6280 include 'COMMON.IOUNITS'
6281 include 'COMMON.FFIELD'
6282 include 'COMMON.TORCNSTR'
6283 include 'COMMON.CONTROL'
6285 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6286 do i=ithetaconstr_start,ithetaconstr_end
6287 itheta=itheta_constr(i)
6288 thetiii=theta(itheta)
6289 difi=pinorm(thetiii-theta_constr0(i))
6290 if (difi.gt.theta_drange(i)) then
6291 difi=difi-theta_drange(i)
6292 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6293 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6294 & +for_thet_constr(i)*difi**3
6295 else if (difi.lt.-drange(i)) then
6297 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6298 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6299 & +for_thet_constr(i)*difi**3
6303 if (energy_dec) then
6304 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6305 & i,itheta,rad2deg*thetiii,
6306 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6307 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6308 & gloc(itheta+nphi-2,icg)
6313 c------------------------------------------------------------------------------
6314 c------------------------------------------------------------------------------
6315 subroutine eback_sc_corr(esccor)
6316 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6317 c conformational states; temporarily implemented as differences
6318 c between UNRES torsional potentials (dependent on three types of
6319 c residues) and the torsional potentials dependent on all 20 types
6320 c of residues computed from AM1 energy surfaces of terminally-blocked
6321 c amino-acid residues.
6322 implicit real*8 (a-h,o-z)
6323 include 'DIMENSIONS'
6324 include 'COMMON.VAR'
6325 include 'COMMON.GEO'
6326 include 'COMMON.LOCAL'
6327 include 'COMMON.TORSION'
6328 include 'COMMON.SCCOR'
6329 include 'COMMON.INTERACT'
6330 include 'COMMON.DERIV'
6331 include 'COMMON.CHAIN'
6332 include 'COMMON.NAMES'
6333 include 'COMMON.IOUNITS'
6334 include 'COMMON.FFIELD'
6335 include 'COMMON.CONTROL'
6337 C Set lprn=.true. for debugging
6340 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6342 do i=itau_start,itau_end
6343 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6345 isccori=isccortyp(itype(i-2))
6346 isccori1=isccortyp(itype(i-1))
6348 do intertyp=1,3 !intertyp
6349 cc Added 09 May 2012 (Adasko)
6350 cc Intertyp means interaction type of backbone mainchain correlation:
6351 c 1 = SC...Ca...Ca...Ca
6352 c 2 = Ca...Ca...Ca...SC
6353 c 3 = SC...Ca...Ca...SCi
6355 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6356 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6357 & (itype(i-1).eq.ntyp1)))
6358 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6359 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6360 & .or.(itype(i).eq.ntyp1)))
6361 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6362 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6363 & (itype(i-3).eq.ntyp1)))) cycle
6364 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6365 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6367 do j=1,nterm_sccor(isccori,isccori1)
6368 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6369 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6370 cosphi=dcos(j*tauangle(intertyp,i))
6371 sinphi=dsin(j*tauangle(intertyp,i))
6372 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6373 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6375 C write (iout,*)"EBACK_SC_COR",esccor,i
6376 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6377 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6378 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6380 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6381 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6382 & (v1sccor(j,1,itori,itori1),j=1,6)
6383 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6384 c gsccor_loc(i-3)=gloci
6390 c------------------------------------------------------------------------------
6391 subroutine multibody(ecorr)
6392 C This subroutine calculates multi-body contributions to energy following
6393 C the idea of Skolnick et al. If side chains I and J make a contact and
6394 C at the same time side chains I+1 and J+1 make a contact, an extra
6395 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6396 implicit real*8 (a-h,o-z)
6397 include 'DIMENSIONS'
6398 include 'COMMON.IOUNITS'
6399 include 'COMMON.DERIV'
6400 include 'COMMON.INTERACT'
6401 include 'COMMON.CONTACTS'
6402 include 'COMMON.CONTMAT'
6403 include 'COMMON.CORRMAT'
6404 double precision gx(3),gx1(3)
6407 C Set lprn=.true. for debugging
6411 write (iout,'(a)') 'Contact function values:'
6413 write (iout,'(i2,20(1x,i2,f10.5))')
6414 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6429 num_conti=num_cont(i)
6430 num_conti1=num_cont(i1)
6435 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6436 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6437 cd & ' ishift=',ishift
6438 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6439 C The system gains extra energy.
6440 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6441 endif ! j1==j+-ishift
6450 c------------------------------------------------------------------------------
6451 double precision function esccorr(i,j,k,l,jj,kk)
6452 implicit real*8 (a-h,o-z)
6453 include 'DIMENSIONS'
6454 include 'COMMON.IOUNITS'
6455 include 'COMMON.DERIV'
6456 include 'COMMON.INTERACT'
6457 include 'COMMON.CONTACTS'
6458 include 'COMMON.CONTMAT'
6459 include 'COMMON.CORRMAT'
6460 double precision gx(3),gx1(3)
6465 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6466 C Calculate the multi-body contribution to energy.
6467 C Calculate multi-body contributions to the gradient.
6468 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6469 cd & k,l,(gacont(m,kk,k),m=1,3)
6471 gx(m) =ekl*gacont(m,jj,i)
6472 gx1(m)=eij*gacont(m,kk,k)
6473 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6474 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6475 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6476 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6480 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6485 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6491 c------------------------------------------------------------------------------
6492 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6493 C This subroutine calculates multi-body contributions to hydrogen-bonding
6494 implicit real*8 (a-h,o-z)
6495 include 'DIMENSIONS'
6496 include 'COMMON.IOUNITS'
6497 include 'COMMON.FFIELD'
6498 include 'COMMON.DERIV'
6499 include 'COMMON.INTERACT'
6500 include 'COMMON.CONTACTS'
6501 include 'COMMON.CONTMAT'
6502 include 'COMMON.CORRMAT'
6503 double precision gx(3),gx1(3)
6506 C Set lprn=.true. for debugging
6509 write (iout,'(a)') 'Contact function values:'
6511 write (iout,'(2i3,50(1x,i2,f5.2))')
6512 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6513 & j=1,num_cont_hb(i))
6517 C Remove the loop below after debugging !!!
6524 C Calculate the local-electrostatic correlation terms
6525 do i=iatel_s,iatel_e+1
6527 num_conti=num_cont_hb(i)
6528 num_conti1=num_cont_hb(i+1)
6533 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6534 c & ' jj=',jj,' kk=',kk
6535 if (j1.eq.j+1 .or. j1.eq.j-1) then
6536 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6537 C The system gains extra energy.
6538 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6540 else if (j1.eq.j) then
6541 C Contacts I-J and I-(J+1) occur simultaneously.
6542 C The system loses extra energy.
6543 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6548 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6549 c & ' jj=',jj,' kk=',kk
6551 C Contacts I-J and (I+1)-J occur simultaneously.
6552 C The system loses extra energy.
6553 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6560 c------------------------------------------------------------------------------
6561 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6563 C This subroutine calculates multi-body contributions to hydrogen-bonding
6564 implicit real*8 (a-h,o-z)
6565 include 'DIMENSIONS'
6566 include 'COMMON.IOUNITS'
6570 include 'COMMON.FFIELD'
6571 include 'COMMON.DERIV'
6572 include 'COMMON.LOCAL'
6573 include 'COMMON.INTERACT'
6574 include 'COMMON.CONTACTS'
6575 include 'COMMON.CONTMAT'
6576 include 'COMMON.CORRMAT'
6577 include 'COMMON.CHAIN'
6578 include 'COMMON.CONTROL'
6579 include 'COMMON.SHIELD'
6580 double precision gx(3),gx1(3)
6581 integer num_cont_hb_old(maxres)
6583 double precision eello4,eello5,eelo6,eello_turn6
6584 external eello4,eello5,eello6,eello_turn6
6585 C Set lprn=.true. for debugging
6589 write (iout,'(a)') 'Contact function values:'
6591 write (iout,'(2i3,50(1x,i2,5f6.3))')
6592 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6593 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6599 C Remove the loop below after debugging !!!
6606 C Calculate the dipole-dipole interaction energies
6607 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6608 do i=iatel_s,iatel_e+1
6609 num_conti=num_cont_hb(i)
6618 C Calculate the local-electrostatic correlation terms
6619 c write (iout,*) "gradcorr5 in eello5 before loop"
6621 c write (iout,'(i5,3f10.5)')
6622 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6624 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6625 c write (iout,*) "corr loop i",i
6627 num_conti=num_cont_hb(i)
6628 num_conti1=num_cont_hb(i+1)
6635 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6636 c & ' jj=',jj,' kk=',kk
6637 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6638 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6639 & .or. j.lt.0 .and. j1.gt.0) .and.
6640 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6641 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6642 C The system gains extra energy.
6644 sqd1=dsqrt(d_cont(jj,i))
6645 sqd2=dsqrt(d_cont(kk,i1))
6646 sred_geom = sqd1*sqd2
6647 IF (sred_geom.lt.cutoff_corr) THEN
6648 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6650 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6651 cd & ' jj=',jj,' kk=',kk
6652 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6653 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6655 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6656 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6659 cd write (iout,*) 'sred_geom=',sred_geom,
6660 cd & ' ekont=',ekont,' fprim=',fprimcont,
6661 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6662 cd write (iout,*) "g_contij",g_contij
6663 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6664 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6665 call calc_eello(i,jp,i+1,jp1,jj,kk)
6666 if (wcorr4.gt.0.0d0)
6667 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6668 CC & *fac_shield(i)**2*fac_shield(j)**2
6669 if (energy_dec.and.wcorr4.gt.0.0d0)
6670 1 write (iout,'(a6,4i5,0pf7.3)')
6671 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6672 c write (iout,*) "gradcorr5 before eello5"
6674 c write (iout,'(i5,3f10.5)')
6675 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6677 if (wcorr5.gt.0.0d0)
6678 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6679 c write (iout,*) "gradcorr5 after eello5"
6681 c write (iout,'(i5,3f10.5)')
6682 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6684 if (energy_dec.and.wcorr5.gt.0.0d0)
6685 1 write (iout,'(a6,4i5,0pf7.3)')
6686 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6687 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6688 cd write(2,*)'ijkl',i,jp,i+1,jp1
6689 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6690 & .or. wturn6.eq.0.0d0))then
6691 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6692 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6693 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6694 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6695 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6696 cd & 'ecorr6=',ecorr6
6697 cd write (iout,'(4e15.5)') sred_geom,
6698 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6699 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6700 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6701 else if (wturn6.gt.0.0d0
6702 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6703 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6704 eturn6=eturn6+eello_turn6(i,jj,kk)
6705 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6706 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6707 cd write (2,*) 'multibody_eello:eturn6',eturn6
6716 num_cont_hb(i)=num_cont_hb_old(i)
6718 c write (iout,*) "gradcorr5 in eello5"
6720 c write (iout,'(i5,3f10.5)')
6721 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6725 c------------------------------------------------------------------------------
6726 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6727 implicit real*8 (a-h,o-z)
6728 include 'DIMENSIONS'
6729 include 'COMMON.IOUNITS'
6730 include 'COMMON.DERIV'
6731 include 'COMMON.INTERACT'
6732 include 'COMMON.CONTACTS'
6733 include 'COMMON.CONTMAT'
6734 include 'COMMON.CORRMAT'
6735 include 'COMMON.SHIELD'
6736 include 'COMMON.CONTROL'
6737 double precision gx(3),gx1(3)
6740 C print *,"wchodze",fac_shield(i),shield_mode
6748 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6750 C & fac_shield(i)**2*fac_shield(j)**2
6751 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6752 C Following 4 lines for diagnostics.
6757 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6758 c & 'Contacts ',i,j,
6759 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6760 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6762 C Calculate the multi-body contribution to energy.
6763 C ecorr=ecorr+ekont*ees
6764 C Calculate multi-body contributions to the gradient.
6765 coeffpees0pij=coeffp*ees0pij
6766 coeffmees0mij=coeffm*ees0mij
6767 coeffpees0pkl=coeffp*ees0pkl
6768 coeffmees0mkl=coeffm*ees0mkl
6770 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6771 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6772 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6773 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6774 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6775 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6776 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6777 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6778 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6779 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6780 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6781 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6782 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6783 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6784 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6785 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6786 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6787 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6788 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6789 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6790 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6791 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6792 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6793 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6794 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6799 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6800 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6801 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6802 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6807 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6808 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6809 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6810 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6813 c write (iout,*) "ehbcorr",ekont*ees
6814 C print *,ekont,ees,i,k
6816 C now gradient over shielding
6818 if (shield_mode.gt.0) then
6821 C print *,i,j,fac_shield(i),fac_shield(j),
6822 C &fac_shield(k),fac_shield(l)
6823 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6824 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6825 do ilist=1,ishield_list(i)
6826 iresshield=shield_list(ilist,i)
6828 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6830 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6832 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6833 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6837 do ilist=1,ishield_list(j)
6838 iresshield=shield_list(ilist,j)
6840 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6842 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6844 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6845 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6850 do ilist=1,ishield_list(k)
6851 iresshield=shield_list(ilist,k)
6853 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6855 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6857 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6858 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6862 do ilist=1,ishield_list(l)
6863 iresshield=shield_list(ilist,l)
6865 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6867 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6869 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6870 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6874 C print *,gshieldx(m,iresshield)
6876 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6877 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6878 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6879 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6880 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6881 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6882 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6883 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6885 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6886 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6887 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6888 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6889 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6890 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6891 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6892 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6900 C---------------------------------------------------------------------------
6901 subroutine dipole(i,j,jj)
6902 implicit real*8 (a-h,o-z)
6903 include 'DIMENSIONS'
6904 include 'COMMON.IOUNITS'
6905 include 'COMMON.CHAIN'
6906 include 'COMMON.FFIELD'
6907 include 'COMMON.DERIV'
6908 include 'COMMON.INTERACT'
6909 include 'COMMON.CONTACTS'
6910 include 'COMMON.CONTMAT'
6911 include 'COMMON.CORRMAT'
6912 include 'COMMON.TORSION'
6913 include 'COMMON.VAR'
6914 include 'COMMON.GEO'
6915 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6917 iti1 = itortyp(itype(i+1))
6918 if (j.lt.nres-1) then
6919 itj1 = itype2loc(itype(j+1))
6924 dipi(iii,1)=Ub2(iii,i)
6925 dipderi(iii)=Ub2der(iii,i)
6926 dipi(iii,2)=b1(iii,i+1)
6927 dipj(iii,1)=Ub2(iii,j)
6928 dipderj(iii)=Ub2der(iii,j)
6929 dipj(iii,2)=b1(iii,j+1)
6933 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6936 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6943 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6947 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6952 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6953 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6955 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6957 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6959 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6964 C---------------------------------------------------------------------------
6965 subroutine calc_eello(i,j,k,l,jj,kk)
6967 C This subroutine computes matrices and vectors needed to calculate
6968 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6970 implicit real*8 (a-h,o-z)
6971 include 'DIMENSIONS'
6972 include 'COMMON.IOUNITS'
6973 include 'COMMON.CHAIN'
6974 include 'COMMON.DERIV'
6975 include 'COMMON.INTERACT'
6976 include 'COMMON.CONTACTS'
6977 include 'COMMON.CONTMAT'
6978 include 'COMMON.CORRMAT'
6979 include 'COMMON.TORSION'
6980 include 'COMMON.VAR'
6981 include 'COMMON.GEO'
6982 include 'COMMON.FFIELD'
6983 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6984 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6987 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6988 cd & ' jj=',jj,' kk=',kk
6989 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6990 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6991 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6994 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6995 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6998 call transpose2(aa1(1,1),aa1t(1,1))
6999 call transpose2(aa2(1,1),aa2t(1,1))
7002 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7003 & aa1tder(1,1,lll,kkk))
7004 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7005 & aa2tder(1,1,lll,kkk))
7009 C parallel orientation of the two CA-CA-CA frames.
7011 iti=itype2loc(itype(i))
7015 itk1=itype2loc(itype(k+1))
7016 itj=itype2loc(itype(j))
7017 if (l.lt.nres-1) then
7018 itl1=itype2loc(itype(l+1))
7022 C A1 kernel(j+1) A2T
7024 cd write (iout,'(3f10.5,5x,3f10.5)')
7025 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7027 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7028 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7029 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7030 C Following matrices are needed only for 6-th order cumulants
7031 IF (wcorr6.gt.0.0d0) THEN
7032 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7033 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7034 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7035 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7036 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7037 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7038 & ADtEAderx(1,1,1,1,1,1))
7040 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7041 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7042 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7043 & ADtEA1derx(1,1,1,1,1,1))
7045 C End 6-th order cumulants
7048 cd write (2,*) 'In calc_eello6'
7050 cd write (2,*) 'iii=',iii
7052 cd write (2,*) 'kkk=',kkk
7054 cd write (2,'(3(2f10.5),5x)')
7055 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7060 call transpose2(EUgder(1,1,k),auxmat(1,1))
7061 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7062 call transpose2(EUg(1,1,k),auxmat(1,1))
7063 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7064 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7068 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7069 & EAEAderx(1,1,lll,kkk,iii,1))
7073 C A1T kernel(i+1) A2
7074 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7075 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7076 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7077 C Following matrices are needed only for 6-th order cumulants
7078 IF (wcorr6.gt.0.0d0) THEN
7079 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7080 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7081 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7082 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7083 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7084 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7085 & ADtEAderx(1,1,1,1,1,2))
7086 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7087 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7088 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7089 & ADtEA1derx(1,1,1,1,1,2))
7091 C End 6-th order cumulants
7092 call transpose2(EUgder(1,1,l),auxmat(1,1))
7093 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7094 call transpose2(EUg(1,1,l),auxmat(1,1))
7095 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7096 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7100 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7101 & EAEAderx(1,1,lll,kkk,iii,2))
7106 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7107 C They are needed only when the fifth- or the sixth-order cumulants are
7109 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7110 call transpose2(AEA(1,1,1),auxmat(1,1))
7111 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7112 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7113 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7114 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7115 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7116 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7117 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7118 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7119 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7120 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7121 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7122 call transpose2(AEA(1,1,2),auxmat(1,1))
7123 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7124 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7125 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7126 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7127 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7128 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7129 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7130 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7131 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7132 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7133 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7134 C Calculate the Cartesian derivatives of the vectors.
7138 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7139 call matvec2(auxmat(1,1),b1(1,i),
7140 & AEAb1derx(1,lll,kkk,iii,1,1))
7141 call matvec2(auxmat(1,1),Ub2(1,i),
7142 & AEAb2derx(1,lll,kkk,iii,1,1))
7143 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7144 & AEAb1derx(1,lll,kkk,iii,2,1))
7145 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7146 & AEAb2derx(1,lll,kkk,iii,2,1))
7147 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7148 call matvec2(auxmat(1,1),b1(1,j),
7149 & AEAb1derx(1,lll,kkk,iii,1,2))
7150 call matvec2(auxmat(1,1),Ub2(1,j),
7151 & AEAb2derx(1,lll,kkk,iii,1,2))
7152 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7153 & AEAb1derx(1,lll,kkk,iii,2,2))
7154 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7155 & AEAb2derx(1,lll,kkk,iii,2,2))
7162 C Antiparallel orientation of the two CA-CA-CA frames.
7164 iti=itype2loc(itype(i))
7168 itk1=itype2loc(itype(k+1))
7169 itl=itype2loc(itype(l))
7170 itj=itype2loc(itype(j))
7171 if (j.lt.nres-1) then
7172 itj1=itype2loc(itype(j+1))
7176 C A2 kernel(j-1)T A1T
7177 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7178 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7179 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7180 C Following matrices are needed only for 6-th order cumulants
7181 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7182 & j.eq.i+4 .and. l.eq.i+3)) THEN
7183 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7184 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7185 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7186 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7187 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7188 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7189 & ADtEAderx(1,1,1,1,1,1))
7190 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7191 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7192 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7193 & ADtEA1derx(1,1,1,1,1,1))
7195 C End 6-th order cumulants
7196 call transpose2(EUgder(1,1,k),auxmat(1,1))
7197 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7198 call transpose2(EUg(1,1,k),auxmat(1,1))
7199 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7200 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7204 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7205 & EAEAderx(1,1,lll,kkk,iii,1))
7209 C A2T kernel(i+1)T A1
7210 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7211 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7212 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7213 C Following matrices are needed only for 6-th order cumulants
7214 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7215 & j.eq.i+4 .and. l.eq.i+3)) THEN
7216 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7217 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7218 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7219 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7220 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7221 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7222 & ADtEAderx(1,1,1,1,1,2))
7223 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7224 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7225 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7226 & ADtEA1derx(1,1,1,1,1,2))
7228 C End 6-th order cumulants
7229 call transpose2(EUgder(1,1,j),auxmat(1,1))
7230 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7231 call transpose2(EUg(1,1,j),auxmat(1,1))
7232 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7233 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7237 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7238 & EAEAderx(1,1,lll,kkk,iii,2))
7243 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7244 C They are needed only when the fifth- or the sixth-order cumulants are
7246 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7247 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7248 call transpose2(AEA(1,1,1),auxmat(1,1))
7249 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7250 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7251 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7252 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7253 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7254 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7255 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7256 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7257 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7258 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7259 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7260 call transpose2(AEA(1,1,2),auxmat(1,1))
7261 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7262 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7263 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7264 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7265 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7266 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7267 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7268 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7269 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7270 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7271 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7272 C Calculate the Cartesian derivatives of the vectors.
7276 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7277 call matvec2(auxmat(1,1),b1(1,i),
7278 & AEAb1derx(1,lll,kkk,iii,1,1))
7279 call matvec2(auxmat(1,1),Ub2(1,i),
7280 & AEAb2derx(1,lll,kkk,iii,1,1))
7281 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7282 & AEAb1derx(1,lll,kkk,iii,2,1))
7283 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7284 & AEAb2derx(1,lll,kkk,iii,2,1))
7285 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7286 call matvec2(auxmat(1,1),b1(1,l),
7287 & AEAb1derx(1,lll,kkk,iii,1,2))
7288 call matvec2(auxmat(1,1),Ub2(1,l),
7289 & AEAb2derx(1,lll,kkk,iii,1,2))
7290 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7291 & AEAb1derx(1,lll,kkk,iii,2,2))
7292 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7293 & AEAb2derx(1,lll,kkk,iii,2,2))
7302 C---------------------------------------------------------------------------
7303 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7304 & KK,KKderg,AKA,AKAderg,AKAderx)
7308 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7309 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7310 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7315 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7317 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7320 cd if (lprn) write (2,*) 'In kernel'
7322 cd if (lprn) write (2,*) 'kkk=',kkk
7324 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7325 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7327 cd write (2,*) 'lll=',lll
7328 cd write (2,*) 'iii=1'
7330 cd write (2,'(3(2f10.5),5x)')
7331 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7334 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7335 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7337 cd write (2,*) 'lll=',lll
7338 cd write (2,*) 'iii=2'
7340 cd write (2,'(3(2f10.5),5x)')
7341 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7348 C---------------------------------------------------------------------------
7349 double precision function eello4(i,j,k,l,jj,kk)
7350 implicit real*8 (a-h,o-z)
7351 include 'DIMENSIONS'
7352 include 'COMMON.IOUNITS'
7353 include 'COMMON.CHAIN'
7354 include 'COMMON.DERIV'
7355 include 'COMMON.INTERACT'
7356 include 'COMMON.CONTACTS'
7357 include 'COMMON.CONTMAT'
7358 include 'COMMON.CORRMAT'
7359 include 'COMMON.TORSION'
7360 include 'COMMON.VAR'
7361 include 'COMMON.GEO'
7362 double precision pizda(2,2),ggg1(3),ggg2(3)
7363 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7367 cd print *,'eello4:',i,j,k,l,jj,kk
7368 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7369 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7370 cold eij=facont_hb(jj,i)
7371 cold ekl=facont_hb(kk,k)
7373 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7375 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7376 gcorr_loc(k-1)=gcorr_loc(k-1)
7377 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7379 gcorr_loc(l-1)=gcorr_loc(l-1)
7380 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7382 gcorr_loc(j-1)=gcorr_loc(j-1)
7383 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7388 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7389 & -EAEAderx(2,2,lll,kkk,iii,1)
7390 cd derx(lll,kkk,iii)=0.0d0
7394 cd gcorr_loc(l-1)=0.0d0
7395 cd gcorr_loc(j-1)=0.0d0
7396 cd gcorr_loc(k-1)=0.0d0
7398 cd write (iout,*)'Contacts have occurred for peptide groups',
7399 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7400 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7401 if (j.lt.nres-1) then
7408 if (l.lt.nres-1) then
7416 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7417 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7418 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7419 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7420 cgrad ghalf=0.5d0*ggg1(ll)
7421 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7422 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7423 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7424 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7425 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7426 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7427 cgrad ghalf=0.5d0*ggg2(ll)
7428 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7429 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7430 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7431 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7432 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7433 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7437 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7442 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7447 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7452 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7456 cd write (2,*) iii,gcorr_loc(iii)
7460 cd write (2,*) 'ekont',ekont
7461 cd write (iout,*) 'eello4',ekont*eel4
7464 C---------------------------------------------------------------------------
7465 double precision function eello5(i,j,k,l,jj,kk)
7466 implicit real*8 (a-h,o-z)
7467 include 'DIMENSIONS'
7468 include 'COMMON.IOUNITS'
7469 include 'COMMON.CHAIN'
7470 include 'COMMON.DERIV'
7471 include 'COMMON.INTERACT'
7472 include 'COMMON.CONTACTS'
7473 include 'COMMON.CONTMAT'
7474 include 'COMMON.CORRMAT'
7475 include 'COMMON.TORSION'
7476 include 'COMMON.VAR'
7477 include 'COMMON.GEO'
7478 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7479 double precision ggg1(3),ggg2(3)
7480 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7485 C /l\ / \ \ / \ / \ / C
7486 C / \ / \ \ / \ / \ / C
7487 C j| o |l1 | o | o| o | | o |o C
7488 C \ |/k\| |/ \| / |/ \| |/ \| C
7489 C \i/ \ / \ / / \ / \ C
7491 C (I) (II) (III) (IV) C
7493 C eello5_1 eello5_2 eello5_3 eello5_4 C
7495 C Antiparallel chains C
7498 C /j\ / \ \ / \ / \ / C
7499 C / \ / \ \ / \ / \ / C
7500 C j1| o |l | o | o| o | | o |o C
7501 C \ |/k\| |/ \| / |/ \| |/ \| C
7502 C \i/ \ / \ / / \ / \ C
7504 C (I) (II) (III) (IV) C
7506 C eello5_1 eello5_2 eello5_3 eello5_4 C
7508 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7510 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7511 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7516 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7518 itk=itype2loc(itype(k))
7519 itl=itype2loc(itype(l))
7520 itj=itype2loc(itype(j))
7525 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7526 cd & eel5_3_num,eel5_4_num)
7530 derx(lll,kkk,iii)=0.0d0
7534 cd eij=facont_hb(jj,i)
7535 cd ekl=facont_hb(kk,k)
7537 cd write (iout,*)'Contacts have occurred for peptide groups',
7538 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7540 C Contribution from the graph I.
7541 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7542 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7543 call transpose2(EUg(1,1,k),auxmat(1,1))
7544 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7545 vv(1)=pizda(1,1)-pizda(2,2)
7546 vv(2)=pizda(1,2)+pizda(2,1)
7547 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7548 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7550 C Explicit gradient in virtual-dihedral angles.
7551 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7552 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7553 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7554 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7555 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7556 vv(1)=pizda(1,1)-pizda(2,2)
7557 vv(2)=pizda(1,2)+pizda(2,1)
7558 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7559 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7560 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7561 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7562 vv(1)=pizda(1,1)-pizda(2,2)
7563 vv(2)=pizda(1,2)+pizda(2,1)
7565 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7566 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7567 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7569 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7570 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7571 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7573 C Cartesian gradient
7577 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7579 vv(1)=pizda(1,1)-pizda(2,2)
7580 vv(2)=pizda(1,2)+pizda(2,1)
7581 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7582 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7583 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7590 C Contribution from graph II
7591 call transpose2(EE(1,1,k),auxmat(1,1))
7592 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7593 vv(1)=pizda(1,1)+pizda(2,2)
7594 vv(2)=pizda(2,1)-pizda(1,2)
7595 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7596 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7598 C Explicit gradient in virtual-dihedral angles.
7599 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7600 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7601 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7602 vv(1)=pizda(1,1)+pizda(2,2)
7603 vv(2)=pizda(2,1)-pizda(1,2)
7605 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7606 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7607 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7609 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7610 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7611 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7613 C Cartesian gradient
7617 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7619 vv(1)=pizda(1,1)+pizda(2,2)
7620 vv(2)=pizda(2,1)-pizda(1,2)
7621 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7622 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7623 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7632 C Parallel orientation
7633 C Contribution from graph III
7634 call transpose2(EUg(1,1,l),auxmat(1,1))
7635 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7636 vv(1)=pizda(1,1)-pizda(2,2)
7637 vv(2)=pizda(1,2)+pizda(2,1)
7638 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7639 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7641 C Explicit gradient in virtual-dihedral angles.
7642 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7643 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7644 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7645 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7646 vv(1)=pizda(1,1)-pizda(2,2)
7647 vv(2)=pizda(1,2)+pizda(2,1)
7648 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7649 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7650 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7651 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7652 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7653 vv(1)=pizda(1,1)-pizda(2,2)
7654 vv(2)=pizda(1,2)+pizda(2,1)
7655 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7656 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7657 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7658 C Cartesian gradient
7662 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7664 vv(1)=pizda(1,1)-pizda(2,2)
7665 vv(2)=pizda(1,2)+pizda(2,1)
7666 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7667 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7668 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7673 C Contribution from graph IV
7675 call transpose2(EE(1,1,l),auxmat(1,1))
7676 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7677 vv(1)=pizda(1,1)+pizda(2,2)
7678 vv(2)=pizda(2,1)-pizda(1,2)
7679 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7680 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7681 C Explicit gradient in virtual-dihedral angles.
7682 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7683 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7684 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7685 vv(1)=pizda(1,1)+pizda(2,2)
7686 vv(2)=pizda(2,1)-pizda(1,2)
7687 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7688 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7689 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7690 C Cartesian gradient
7694 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7696 vv(1)=pizda(1,1)+pizda(2,2)
7697 vv(2)=pizda(2,1)-pizda(1,2)
7698 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7699 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7700 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7706 C Antiparallel orientation
7707 C Contribution from graph III
7709 call transpose2(EUg(1,1,j),auxmat(1,1))
7710 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7711 vv(1)=pizda(1,1)-pizda(2,2)
7712 vv(2)=pizda(1,2)+pizda(2,1)
7713 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7714 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7716 C Explicit gradient in virtual-dihedral angles.
7717 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7718 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7719 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7720 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7721 vv(1)=pizda(1,1)-pizda(2,2)
7722 vv(2)=pizda(1,2)+pizda(2,1)
7723 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7724 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7725 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7726 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7727 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7728 vv(1)=pizda(1,1)-pizda(2,2)
7729 vv(2)=pizda(1,2)+pizda(2,1)
7730 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7731 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7732 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7733 C Cartesian gradient
7737 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7739 vv(1)=pizda(1,1)-pizda(2,2)
7740 vv(2)=pizda(1,2)+pizda(2,1)
7741 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7742 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7743 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7749 C Contribution from graph IV
7751 call transpose2(EE(1,1,j),auxmat(1,1))
7752 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7753 vv(1)=pizda(1,1)+pizda(2,2)
7754 vv(2)=pizda(2,1)-pizda(1,2)
7755 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7756 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7758 C Explicit gradient in virtual-dihedral angles.
7759 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7760 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7761 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7762 vv(1)=pizda(1,1)+pizda(2,2)
7763 vv(2)=pizda(2,1)-pizda(1,2)
7764 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7765 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7766 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7767 C Cartesian gradient
7771 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7773 vv(1)=pizda(1,1)+pizda(2,2)
7774 vv(2)=pizda(2,1)-pizda(1,2)
7775 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7776 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7777 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7784 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7785 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7786 cd write (2,*) 'ijkl',i,j,k,l
7787 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7788 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7790 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7791 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7792 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7793 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7795 if (j.lt.nres-1) then
7802 if (l.lt.nres-1) then
7812 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7813 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7814 C summed up outside the subrouine as for the other subroutines
7815 C handling long-range interactions. The old code is commented out
7816 C with "cgrad" to keep track of changes.
7818 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7819 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7820 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7821 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7822 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7823 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7824 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7825 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7826 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7827 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7829 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7830 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7831 cgrad ghalf=0.5d0*ggg1(ll)
7833 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7834 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7835 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7836 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7837 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7838 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7839 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7840 cgrad ghalf=0.5d0*ggg2(ll)
7842 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7843 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7844 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7845 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7846 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7847 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7853 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7854 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7859 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7860 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7866 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7871 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7875 cd write (2,*) iii,g_corr5_loc(iii)
7878 cd write (2,*) 'ekont',ekont
7879 cd write (iout,*) 'eello5',ekont*eel5
7882 c--------------------------------------------------------------------------
7883 double precision function eello6(i,j,k,l,jj,kk)
7884 implicit real*8 (a-h,o-z)
7885 include 'DIMENSIONS'
7886 include 'COMMON.IOUNITS'
7887 include 'COMMON.CHAIN'
7888 include 'COMMON.DERIV'
7889 include 'COMMON.INTERACT'
7890 include 'COMMON.CONTACTS'
7891 include 'COMMON.CONTMAT'
7892 include 'COMMON.CORRMAT'
7893 include 'COMMON.TORSION'
7894 include 'COMMON.VAR'
7895 include 'COMMON.GEO'
7896 include 'COMMON.FFIELD'
7897 double precision ggg1(3),ggg2(3)
7898 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7903 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7911 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7912 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7916 derx(lll,kkk,iii)=0.0d0
7920 cd eij=facont_hb(jj,i)
7921 cd ekl=facont_hb(kk,k)
7927 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7928 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7929 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7930 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7931 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7932 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7934 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7935 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7936 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7937 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7938 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7939 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7943 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7945 C If turn contributions are considered, they will be handled separately.
7946 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7947 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7948 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7949 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7950 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7951 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7952 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7955 if (j.lt.nres-1) then
7962 if (l.lt.nres-1) then
7970 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7971 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7972 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7973 cgrad ghalf=0.5d0*ggg1(ll)
7975 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7976 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7977 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7978 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7979 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7980 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7981 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7982 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7983 cgrad ghalf=0.5d0*ggg2(ll)
7984 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7986 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7987 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7988 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7989 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7990 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7991 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7997 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7998 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8003 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8004 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8010 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8015 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8019 cd write (2,*) iii,g_corr6_loc(iii)
8022 cd write (2,*) 'ekont',ekont
8023 cd write (iout,*) 'eello6',ekont*eel6
8026 c--------------------------------------------------------------------------
8027 double precision function eello6_graph1(i,j,k,l,imat,swap)
8028 implicit real*8 (a-h,o-z)
8029 include 'DIMENSIONS'
8030 include 'COMMON.IOUNITS'
8031 include 'COMMON.CHAIN'
8032 include 'COMMON.DERIV'
8033 include 'COMMON.INTERACT'
8034 include 'COMMON.CONTACTS'
8035 include 'COMMON.CONTMAT'
8036 include 'COMMON.CORRMAT'
8037 include 'COMMON.TORSION'
8038 include 'COMMON.VAR'
8039 include 'COMMON.GEO'
8040 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8044 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8046 C Parallel Antiparallel C
8052 C \ j|/k\| / \ |/k\|l / C
8057 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8058 itk=itype2loc(itype(k))
8059 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8060 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8061 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8062 call transpose2(EUgC(1,1,k),auxmat(1,1))
8063 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8064 vv1(1)=pizda1(1,1)-pizda1(2,2)
8065 vv1(2)=pizda1(1,2)+pizda1(2,1)
8066 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8067 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8068 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8069 s5=scalar2(vv(1),Dtobr2(1,i))
8070 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8071 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8073 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8074 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8075 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8076 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8077 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8078 & +scalar2(vv(1),Dtobr2der(1,i)))
8079 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8080 vv1(1)=pizda1(1,1)-pizda1(2,2)
8081 vv1(2)=pizda1(1,2)+pizda1(2,1)
8082 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8083 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8085 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8086 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8087 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8088 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8089 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8091 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8092 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8093 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8094 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8095 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8097 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8098 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8099 vv1(1)=pizda1(1,1)-pizda1(2,2)
8100 vv1(2)=pizda1(1,2)+pizda1(2,1)
8101 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8102 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8103 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8104 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8113 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8114 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8115 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8116 call transpose2(EUgC(1,1,k),auxmat(1,1))
8117 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8119 vv1(1)=pizda1(1,1)-pizda1(2,2)
8120 vv1(2)=pizda1(1,2)+pizda1(2,1)
8121 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8122 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8123 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8124 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8125 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8126 s5=scalar2(vv(1),Dtobr2(1,i))
8127 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8134 c----------------------------------------------------------------------------
8135 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8136 implicit real*8 (a-h,o-z)
8137 include 'DIMENSIONS'
8138 include 'COMMON.IOUNITS'
8139 include 'COMMON.CHAIN'
8140 include 'COMMON.DERIV'
8141 include 'COMMON.INTERACT'
8142 include 'COMMON.CONTACTS'
8143 include 'COMMON.CONTMAT'
8144 include 'COMMON.CORRMAT'
8145 include 'COMMON.TORSION'
8146 include 'COMMON.VAR'
8147 include 'COMMON.GEO'
8149 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8150 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8153 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8155 C Parallel Antiparallel C
8161 C \ j|/k\| \ |/k\|l C
8166 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8167 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8168 C AL 7/4/01 s1 would occur in the sixth-order moment,
8169 C but not in a cluster cumulant
8171 s1=dip(1,jj,i)*dip(1,kk,k)
8173 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8174 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8175 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8176 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8177 call transpose2(EUg(1,1,k),auxmat(1,1))
8178 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8179 vv(1)=pizda(1,1)-pizda(2,2)
8180 vv(2)=pizda(1,2)+pizda(2,1)
8181 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8182 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8184 eello6_graph2=-(s1+s2+s3+s4)
8186 eello6_graph2=-(s2+s3+s4)
8189 C Derivatives in gamma(i-1)
8193 s1=dipderg(1,jj,i)*dip(1,kk,k)
8195 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8196 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8197 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8198 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8200 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8202 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8204 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8206 C Derivatives in gamma(k-1)
8208 s1=dip(1,jj,i)*dipderg(1,kk,k)
8210 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8211 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8212 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8213 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8214 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8215 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8216 vv(1)=pizda(1,1)-pizda(2,2)
8217 vv(2)=pizda(1,2)+pizda(2,1)
8218 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8220 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8222 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8224 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8225 C Derivatives in gamma(j-1) or gamma(l-1)
8228 s1=dipderg(3,jj,i)*dip(1,kk,k)
8230 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8231 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8232 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8233 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8234 vv(1)=pizda(1,1)-pizda(2,2)
8235 vv(2)=pizda(1,2)+pizda(2,1)
8236 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8239 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8241 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8244 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8245 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8247 C Derivatives in gamma(l-1) or gamma(j-1)
8250 s1=dip(1,jj,i)*dipderg(3,kk,k)
8252 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8253 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8254 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8255 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8256 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8257 vv(1)=pizda(1,1)-pizda(2,2)
8258 vv(2)=pizda(1,2)+pizda(2,1)
8259 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8262 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8264 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8267 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8268 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8270 C Cartesian derivatives.
8272 write (2,*) 'In eello6_graph2'
8274 write (2,*) 'iii=',iii
8276 write (2,*) 'kkk=',kkk
8278 write (2,'(3(2f10.5),5x)')
8279 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8289 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8291 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8294 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8296 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8297 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8299 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8300 call transpose2(EUg(1,1,k),auxmat(1,1))
8301 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8303 vv(1)=pizda(1,1)-pizda(2,2)
8304 vv(2)=pizda(1,2)+pizda(2,1)
8305 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8306 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8308 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8310 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8313 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8315 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8323 c----------------------------------------------------------------------------
8324 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8325 implicit real*8 (a-h,o-z)
8326 include 'DIMENSIONS'
8327 include 'COMMON.IOUNITS'
8328 include 'COMMON.CHAIN'
8329 include 'COMMON.DERIV'
8330 include 'COMMON.INTERACT'
8331 include 'COMMON.CONTACTS'
8332 include 'COMMON.CONTMAT'
8333 include 'COMMON.CORRMAT'
8334 include 'COMMON.TORSION'
8335 include 'COMMON.VAR'
8336 include 'COMMON.GEO'
8337 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8339 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8341 C Parallel Antiparallel C
8347 C j|/k\| / |/k\|l / C
8352 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8354 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8355 C energy moment and not to the cluster cumulant.
8356 iti=itortyp(itype(i))
8357 if (j.lt.nres-1) then
8358 itj1=itype2loc(itype(j+1))
8362 itk=itype2loc(itype(k))
8363 itk1=itype2loc(itype(k+1))
8364 if (l.lt.nres-1) then
8365 itl1=itype2loc(itype(l+1))
8370 s1=dip(4,jj,i)*dip(4,kk,k)
8372 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8373 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8374 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8375 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8376 call transpose2(EE(1,1,k),auxmat(1,1))
8377 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8378 vv(1)=pizda(1,1)+pizda(2,2)
8379 vv(2)=pizda(2,1)-pizda(1,2)
8380 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8381 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8382 cd & "sum",-(s2+s3+s4)
8384 eello6_graph3=-(s1+s2+s3+s4)
8386 eello6_graph3=-(s2+s3+s4)
8389 C Derivatives in gamma(k-1)
8391 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8392 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8393 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8394 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8395 C Derivatives in gamma(l-1)
8396 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8397 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8398 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8399 vv(1)=pizda(1,1)+pizda(2,2)
8400 vv(2)=pizda(2,1)-pizda(1,2)
8401 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8402 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8403 C Cartesian derivatives.
8409 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8411 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8414 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8416 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8417 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8419 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8420 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8422 vv(1)=pizda(1,1)+pizda(2,2)
8423 vv(2)=pizda(2,1)-pizda(1,2)
8424 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8426 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8428 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8431 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8433 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8435 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8442 c----------------------------------------------------------------------------
8443 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8444 implicit real*8 (a-h,o-z)
8445 include 'DIMENSIONS'
8446 include 'COMMON.IOUNITS'
8447 include 'COMMON.CHAIN'
8448 include 'COMMON.DERIV'
8449 include 'COMMON.INTERACT'
8450 include 'COMMON.CONTACTS'
8451 include 'COMMON.CONTMAT'
8452 include 'COMMON.CORRMAT'
8453 include 'COMMON.TORSION'
8454 include 'COMMON.VAR'
8455 include 'COMMON.GEO'
8456 include 'COMMON.FFIELD'
8457 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8458 & auxvec1(2),auxmat1(2,2)
8460 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8462 C Parallel Antiparallel C
8468 C \ j|/k\| \ |/k\|l C
8473 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8475 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8476 C energy moment and not to the cluster cumulant.
8477 cd write (2,*) 'eello_graph4: wturn6',wturn6
8478 iti=itype2loc(itype(i))
8479 itj=itype2loc(itype(j))
8480 if (j.lt.nres-1) then
8481 itj1=itype2loc(itype(j+1))
8485 itk=itype2loc(itype(k))
8486 if (k.lt.nres-1) then
8487 itk1=itype2loc(itype(k+1))
8491 itl=itype2loc(itype(l))
8492 if (l.lt.nres-1) then
8493 itl1=itype2loc(itype(l+1))
8497 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8498 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8499 cd & ' itl',itl,' itl1',itl1
8502 s1=dip(3,jj,i)*dip(3,kk,k)
8504 s1=dip(2,jj,j)*dip(2,kk,l)
8507 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8508 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8510 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8511 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8513 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8514 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8516 call transpose2(EUg(1,1,k),auxmat(1,1))
8517 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8518 vv(1)=pizda(1,1)-pizda(2,2)
8519 vv(2)=pizda(2,1)+pizda(1,2)
8520 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8521 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8523 eello6_graph4=-(s1+s2+s3+s4)
8525 eello6_graph4=-(s2+s3+s4)
8527 C Derivatives in gamma(i-1)
8532 s1=dipderg(2,jj,i)*dip(3,kk,k)
8534 s1=dipderg(4,jj,j)*dip(2,kk,l)
8537 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8539 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8540 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8542 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8543 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8545 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8546 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8547 cd write (2,*) 'turn6 derivatives'
8549 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8551 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8555 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8557 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8561 C Derivatives in gamma(k-1)
8564 s1=dip(3,jj,i)*dipderg(2,kk,k)
8566 s1=dip(2,jj,j)*dipderg(4,kk,l)
8569 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8570 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8572 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8573 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8575 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8576 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8578 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8579 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8580 vv(1)=pizda(1,1)-pizda(2,2)
8581 vv(2)=pizda(2,1)+pizda(1,2)
8582 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8583 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8585 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8587 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8591 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8593 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8596 C Derivatives in gamma(j-1) or gamma(l-1)
8597 if (l.eq.j+1 .and. l.gt.1) then
8598 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8599 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8600 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8601 vv(1)=pizda(1,1)-pizda(2,2)
8602 vv(2)=pizda(2,1)+pizda(1,2)
8603 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8604 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8605 else if (j.gt.1) then
8606 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8607 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8608 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8609 vv(1)=pizda(1,1)-pizda(2,2)
8610 vv(2)=pizda(2,1)+pizda(1,2)
8611 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8612 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8613 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8615 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8618 C Cartesian derivatives.
8625 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8627 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8631 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8633 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8637 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8639 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8641 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8642 & b1(1,j+1),auxvec(1))
8643 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8645 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8646 & b1(1,l+1),auxvec(1))
8647 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8649 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8651 vv(1)=pizda(1,1)-pizda(2,2)
8652 vv(2)=pizda(2,1)+pizda(1,2)
8653 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8655 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8657 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8660 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8663 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8666 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8668 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8670 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8674 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8676 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8679 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8681 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8690 c----------------------------------------------------------------------------
8691 double precision function eello_turn6(i,jj,kk)
8692 implicit real*8 (a-h,o-z)
8693 include 'DIMENSIONS'
8694 include 'COMMON.IOUNITS'
8695 include 'COMMON.CHAIN'
8696 include 'COMMON.DERIV'
8697 include 'COMMON.INTERACT'
8698 include 'COMMON.CONTACTS'
8699 include 'COMMON.CONTMAT'
8700 include 'COMMON.CORRMAT'
8701 include 'COMMON.TORSION'
8702 include 'COMMON.VAR'
8703 include 'COMMON.GEO'
8704 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8705 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8707 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8708 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8709 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8710 C the respective energy moment and not to the cluster cumulant.
8719 iti=itype2loc(itype(i))
8720 itk=itype2loc(itype(k))
8721 itk1=itype2loc(itype(k+1))
8722 itl=itype2loc(itype(l))
8723 itj=itype2loc(itype(j))
8724 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8725 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8726 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8731 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8733 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8737 derx_turn(lll,kkk,iii)=0.0d0
8744 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8746 cd write (2,*) 'eello6_5',eello6_5
8748 call transpose2(AEA(1,1,1),auxmat(1,1))
8749 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8750 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8751 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8753 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8754 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8755 s2 = scalar2(b1(1,k),vtemp1(1))
8757 call transpose2(AEA(1,1,2),atemp(1,1))
8758 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8759 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8760 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8762 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8763 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8764 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8766 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8767 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8768 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8769 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8770 ss13 = scalar2(b1(1,k),vtemp4(1))
8771 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8773 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8779 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8780 C Derivatives in gamma(i+2)
8785 call transpose2(AEA(1,1,1),auxmatd(1,1))
8786 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8787 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8788 call transpose2(AEAderg(1,1,2),atempd(1,1))
8789 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8790 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8792 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8793 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8794 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8800 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8801 C Derivatives in gamma(i+3)
8803 call transpose2(AEA(1,1,1),auxmatd(1,1))
8804 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8805 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8806 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8808 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8809 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8810 s2d = scalar2(b1(1,k),vtemp1d(1))
8812 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8813 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8815 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8817 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8818 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8819 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8827 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8828 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8830 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8831 & -0.5d0*ekont*(s2d+s12d)
8833 C Derivatives in gamma(i+4)
8834 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8835 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8836 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8838 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8839 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8840 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8848 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8850 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8852 C Derivatives in gamma(i+5)
8854 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8855 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8856 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8858 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8859 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8860 s2d = scalar2(b1(1,k),vtemp1d(1))
8862 call transpose2(AEA(1,1,2),atempd(1,1))
8863 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8864 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8866 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8867 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8869 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8870 ss13d = scalar2(b1(1,k),vtemp4d(1))
8871 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8879 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8880 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8882 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8883 & -0.5d0*ekont*(s2d+s12d)
8885 C Cartesian derivatives
8890 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8891 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8892 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8894 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8895 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8897 s2d = scalar2(b1(1,k),vtemp1d(1))
8899 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8900 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8901 s8d = -(atempd(1,1)+atempd(2,2))*
8902 & scalar2(cc(1,1,l),vtemp2(1))
8904 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8906 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8907 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8914 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8917 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8921 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8922 & - 0.5d0*(s8d+s12d)
8924 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8933 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8935 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8936 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8937 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8938 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8939 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8941 ss13d = scalar2(b1(1,k),vtemp4d(1))
8942 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8943 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8947 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8948 cd & 16*eel_turn6_num
8950 if (j.lt.nres-1) then
8957 if (l.lt.nres-1) then
8965 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8966 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8967 cgrad ghalf=0.5d0*ggg1(ll)
8969 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8970 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8971 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8972 & +ekont*derx_turn(ll,2,1)
8973 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8974 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8975 & +ekont*derx_turn(ll,4,1)
8976 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8977 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8978 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8979 cgrad ghalf=0.5d0*ggg2(ll)
8981 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8982 & +ekont*derx_turn(ll,2,2)
8983 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8984 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8985 & +ekont*derx_turn(ll,4,2)
8986 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8987 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8988 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8993 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8998 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9004 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9009 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9013 cd write (2,*) iii,g_corr6_loc(iii)
9016 eello_turn6=ekont*eel_turn6
9017 cd write (2,*) 'ekont',ekont
9018 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9022 crc-------------------------------------------------
9023 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9024 subroutine Eliptransfer(eliptran)
9025 implicit real*8 (a-h,o-z)
9026 include 'DIMENSIONS'
9027 include 'COMMON.GEO'
9028 include 'COMMON.VAR'
9029 include 'COMMON.LOCAL'
9030 include 'COMMON.CHAIN'
9031 include 'COMMON.DERIV'
9032 include 'COMMON.INTERACT'
9033 include 'COMMON.IOUNITS'
9034 include 'COMMON.CALC'
9035 include 'COMMON.CONTROL'
9036 include 'COMMON.SPLITELE'
9037 include 'COMMON.SBRIDGE'
9038 C this is done by Adasko
9042 C--bordliptop-- buffore starts
9043 C--bufliptop--- here true lipid starts
9045 C--buflipbot--- lipid ends buffore starts
9046 C--bordlipbot--buffore ends
9050 if (itype(i).eq.ntyp1) cycle
9052 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9053 if (positi.le.0) positi=positi+boxzsize
9055 C first for peptide groups
9056 c for each residue check if it is in lipid or lipid water border area
9057 if ((positi.gt.bordlipbot)
9058 &.and.(positi.lt.bordliptop)) then
9059 C the energy transfer exist
9060 if (positi.lt.buflipbot) then
9061 C what fraction I am in
9063 & ((positi-bordlipbot)/lipbufthick)
9064 C lipbufthick is thickenes of lipid buffore
9065 sslip=sscalelip(fracinbuf)
9066 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9067 eliptran=eliptran+sslip*pepliptran
9068 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9069 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9070 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9071 elseif (positi.gt.bufliptop) then
9072 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9073 sslip=sscalelip(fracinbuf)
9074 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9075 eliptran=eliptran+sslip*pepliptran
9076 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9077 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9078 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9079 C print *, "doing sscalefor top part"
9080 C print *,i,sslip,fracinbuf,ssgradlip
9082 eliptran=eliptran+pepliptran
9083 C print *,"I am in true lipid"
9086 C eliptran=elpitran+0.0 ! I am in water
9089 C print *, "nic nie bylo w lipidzie?"
9090 C now multiply all by the peptide group transfer factor
9091 C eliptran=eliptran*pepliptran
9092 C now the same for side chains
9095 if (itype(i).eq.ntyp1) cycle
9096 positi=(mod(c(3,i+nres),boxzsize))
9097 if (positi.le.0) positi=positi+boxzsize
9098 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9099 c for each residue check if it is in lipid or lipid water border area
9100 C respos=mod(c(3,i+nres),boxzsize)
9101 C print *,positi,bordlipbot,buflipbot
9102 if ((positi.gt.bordlipbot)
9103 & .and.(positi.lt.bordliptop)) then
9104 C the energy transfer exist
9105 if (positi.lt.buflipbot) then
9107 & ((positi-bordlipbot)/lipbufthick)
9108 C lipbufthick is thickenes of lipid buffore
9109 sslip=sscalelip(fracinbuf)
9110 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9111 eliptran=eliptran+sslip*liptranene(itype(i))
9112 gliptranx(3,i)=gliptranx(3,i)
9113 &+ssgradlip*liptranene(itype(i))
9114 gliptranc(3,i-1)= gliptranc(3,i-1)
9115 &+ssgradlip*liptranene(itype(i))
9116 C print *,"doing sccale for lower part"
9117 elseif (positi.gt.bufliptop) then
9119 &((bordliptop-positi)/lipbufthick)
9120 sslip=sscalelip(fracinbuf)
9121 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9122 eliptran=eliptran+sslip*liptranene(itype(i))
9123 gliptranx(3,i)=gliptranx(3,i)
9124 &+ssgradlip*liptranene(itype(i))
9125 gliptranc(3,i-1)= gliptranc(3,i-1)
9126 &+ssgradlip*liptranene(itype(i))
9127 C print *, "doing sscalefor top part",sslip,fracinbuf
9129 eliptran=eliptran+liptranene(itype(i))
9130 C print *,"I am in true lipid"
9132 endif ! if in lipid or buffor
9134 C eliptran=elpitran+0.0 ! I am in water
9140 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9142 SUBROUTINE MATVEC2(A1,V1,V2)
9143 implicit real*8 (a-h,o-z)
9144 include 'DIMENSIONS'
9145 DIMENSION A1(2,2),V1(2),V2(2)
9149 c 3 VI=VI+A1(I,K)*V1(K)
9153 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9154 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9159 C---------------------------------------
9160 SUBROUTINE MATMAT2(A1,A2,A3)
9161 implicit real*8 (a-h,o-z)
9162 include 'DIMENSIONS'
9163 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9164 c DIMENSION AI3(2,2)
9168 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9174 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9175 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9176 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9177 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9185 c-------------------------------------------------------------------------
9186 double precision function scalar2(u,v)
9188 double precision u(2),v(2)
9191 scalar2=u(1)*v(1)+u(2)*v(2)
9195 C-----------------------------------------------------------------------------
9197 subroutine transpose2(a,at)
9199 double precision a(2,2),at(2,2)
9206 c--------------------------------------------------------------------------
9207 subroutine transpose(n,a,at)
9210 double precision a(n,n),at(n,n)
9218 C---------------------------------------------------------------------------
9219 subroutine prodmat3(a1,a2,kk,transp,prod)
9222 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9224 crc double precision auxmat(2,2),prod_(2,2)
9227 crc call transpose2(kk(1,1),auxmat(1,1))
9228 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9229 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9231 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9232 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9233 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9234 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9235 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9236 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9237 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9238 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9241 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9242 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9244 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9245 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9246 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9247 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9248 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9249 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9250 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9251 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9254 c call transpose2(a2(1,1),a2t(1,1))
9257 crc print *,((prod_(i,j),i=1,2),j=1,2)
9258 crc print *,((prod(i,j),i=1,2),j=1,2)
9262 C-----------------------------------------------------------------------------
9263 double precision function scalar(u,v)
9265 double precision u(3),v(3)
9275 C-----------------------------------------------------------------------
9276 double precision function sscale(r)
9277 double precision r,gamm
9278 include "COMMON.SPLITELE"
9279 if(r.lt.r_cut-rlamb) then
9281 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9282 gamm=(r-(r_cut-rlamb))/rlamb
9283 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9289 C-----------------------------------------------------------------------
9290 C-----------------------------------------------------------------------
9291 double precision function sscagrad(r)
9292 double precision r,gamm
9293 include "COMMON.SPLITELE"
9294 if(r.lt.r_cut-rlamb) then
9296 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9297 gamm=(r-(r_cut-rlamb))/rlamb
9298 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9304 C-----------------------------------------------------------------------
9305 C-----------------------------------------------------------------------
9306 double precision function sscalelip(r)
9307 double precision r,gamm
9308 include "COMMON.SPLITELE"
9309 C if(r.lt.r_cut-rlamb) then
9311 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9312 C gamm=(r-(r_cut-rlamb))/rlamb
9313 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9319 C-----------------------------------------------------------------------
9320 double precision function sscagradlip(r)
9321 double precision r,gamm
9322 include "COMMON.SPLITELE"
9323 C if(r.lt.r_cut-rlamb) then
9325 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9326 C gamm=(r-(r_cut-rlamb))/rlamb
9327 sscagradlip=r*(6*r-6.0d0)
9334 C-----------------------------------------------------------------------
9335 subroutine set_shield_fac
9336 implicit real*8 (a-h,o-z)
9337 include 'DIMENSIONS'
9338 include 'COMMON.CHAIN'
9339 include 'COMMON.DERIV'
9340 include 'COMMON.IOUNITS'
9341 include 'COMMON.SHIELD'
9342 include 'COMMON.INTERACT'
9343 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9344 double precision div77_81/0.974996043d0/,
9345 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9347 C the vector between center of side_chain and peptide group
9348 double precision pep_side(3),long,side_calf(3),
9349 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9350 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9351 C the line belowe needs to be changed for FGPROC>1
9353 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9355 Cif there two consequtive dummy atoms there is no peptide group between them
9356 C the line below has to be changed for FGPROC>1
9359 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9363 C first lets set vector conecting the ithe side-chain with kth side-chain
9364 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9366 C and vector conecting the side-chain with its proper calfa
9367 side_calf(j)=c(j,k+nres)-c(j,k)
9368 C side_calf(j)=2.0d0
9369 pept_group(j)=c(j,i)-c(j,i+1)
9370 C lets have their lenght
9371 dist_pep_side=pep_side(j)**2+dist_pep_side
9372 dist_side_calf=dist_side_calf+side_calf(j)**2
9373 dist_pept_group=dist_pept_group+pept_group(j)**2
9375 dist_pep_side=dsqrt(dist_pep_side)
9376 dist_pept_group=dsqrt(dist_pept_group)
9377 dist_side_calf=dsqrt(dist_side_calf)
9379 pep_side_norm(j)=pep_side(j)/dist_pep_side
9380 side_calf_norm(j)=dist_side_calf
9382 C now sscale fraction
9383 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9384 C print *,buff_shield,"buff"
9386 if (sh_frac_dist.le.0.0) cycle
9387 C If we reach here it means that this side chain reaches the shielding sphere
9388 C Lets add him to the list for gradient
9389 ishield_list(i)=ishield_list(i)+1
9390 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9391 C this list is essential otherwise problem would be O3
9392 shield_list(ishield_list(i),i)=k
9393 C Lets have the sscale value
9394 if (sh_frac_dist.gt.1.0) then
9395 scale_fac_dist=1.0d0
9397 sh_frac_dist_grad(j)=0.0d0
9400 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9401 & *(2.0*sh_frac_dist-3.0d0)
9402 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9403 & /dist_pep_side/buff_shield*0.5
9404 C remember for the final gradient multiply sh_frac_dist_grad(j)
9405 C for side_chain by factor -2 !
9407 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9408 C print *,"jestem",scale_fac_dist,fac_help_scale,
9409 C & sh_frac_dist_grad(j)
9412 C if ((i.eq.3).and.(k.eq.2)) then
9413 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9417 C this is what is now we have the distance scaling now volume...
9418 short=short_r_sidechain(itype(k))
9419 long=long_r_sidechain(itype(k))
9420 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9423 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9426 costhet_grad(j)=costhet_fac*pep_side(j)
9428 C remember for the final gradient multiply costhet_grad(j)
9429 C for side_chain by factor -2 !
9430 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9431 C pep_side0pept_group is vector multiplication
9432 pep_side0pept_group=0.0
9434 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9436 cosalfa=(pep_side0pept_group/
9437 & (dist_pep_side*dist_side_calf))
9438 fac_alfa_sin=1.0-cosalfa**2
9439 fac_alfa_sin=dsqrt(fac_alfa_sin)
9440 rkprim=fac_alfa_sin*(long-short)+short
9442 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9443 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9446 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9447 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9448 &*(long-short)/fac_alfa_sin*cosalfa/
9449 &((dist_pep_side*dist_side_calf))*
9450 &((side_calf(j))-cosalfa*
9451 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9453 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9454 &*(long-short)/fac_alfa_sin*cosalfa
9455 &/((dist_pep_side*dist_side_calf))*
9457 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9460 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9463 C now the gradient...
9464 C grad_shield is gradient of Calfa for peptide groups
9465 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9467 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9468 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9470 grad_shield(j,i)=grad_shield(j,i)
9471 C gradient po skalowaniu
9472 & +(sh_frac_dist_grad(j)
9473 C gradient po costhet
9474 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9475 &-scale_fac_dist*(cosphi_grad_long(j))
9476 &/(1.0-cosphi) )*div77_81
9478 C grad_shield_side is Cbeta sidechain gradient
9479 grad_shield_side(j,ishield_list(i),i)=
9480 & (sh_frac_dist_grad(j)*(-2.0d0)
9481 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9482 & +scale_fac_dist*(cosphi_grad_long(j))
9483 & *2.0d0/(1.0-cosphi))
9484 & *div77_81*VofOverlap
9486 grad_shield_loc(j,ishield_list(i),i)=
9487 & scale_fac_dist*cosphi_grad_loc(j)
9488 & *2.0d0/(1.0-cosphi)
9489 & *div77_81*VofOverlap
9491 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9493 fac_shield(i)=VolumeTotal*div77_81+div4_81
9494 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9498 C--------------------------------------------------------------------------
9499 C first for shielding is setting of function of side-chains
9500 subroutine set_shield_fac2
9501 implicit real*8 (a-h,o-z)
9502 include 'DIMENSIONS'
9503 include 'COMMON.CHAIN'
9504 include 'COMMON.DERIV'
9505 include 'COMMON.IOUNITS'
9506 include 'COMMON.SHIELD'
9507 include 'COMMON.INTERACT'
9508 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9509 double precision div77_81/0.974996043d0/,
9510 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9512 C the vector between center of side_chain and peptide group
9513 double precision pep_side(3),long,side_calf(3),
9514 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9515 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9516 C the line belowe needs to be changed for FGPROC>1
9518 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9520 Cif there two consequtive dummy atoms there is no peptide group between them
9521 C the line below has to be changed for FGPROC>1
9524 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9528 C first lets set vector conecting the ithe side-chain with kth side-chain
9529 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9531 C and vector conecting the side-chain with its proper calfa
9532 side_calf(j)=c(j,k+nres)-c(j,k)
9533 C side_calf(j)=2.0d0
9534 pept_group(j)=c(j,i)-c(j,i+1)
9535 C lets have their lenght
9536 dist_pep_side=pep_side(j)**2+dist_pep_side
9537 dist_side_calf=dist_side_calf+side_calf(j)**2
9538 dist_pept_group=dist_pept_group+pept_group(j)**2
9540 dist_pep_side=dsqrt(dist_pep_side)
9541 dist_pept_group=dsqrt(dist_pept_group)
9542 dist_side_calf=dsqrt(dist_side_calf)
9544 pep_side_norm(j)=pep_side(j)/dist_pep_side
9545 side_calf_norm(j)=dist_side_calf
9547 C now sscale fraction
9548 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9549 C print *,buff_shield,"buff"
9551 if (sh_frac_dist.le.0.0) cycle
9552 C If we reach here it means that this side chain reaches the shielding sphere
9553 C Lets add him to the list for gradient
9554 ishield_list(i)=ishield_list(i)+1
9555 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9556 C this list is essential otherwise problem would be O3
9557 shield_list(ishield_list(i),i)=k
9558 C Lets have the sscale value
9559 if (sh_frac_dist.gt.1.0) then
9560 scale_fac_dist=1.0d0
9562 sh_frac_dist_grad(j)=0.0d0
9565 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9566 & *(2.0d0*sh_frac_dist-3.0d0)
9567 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9568 & /dist_pep_side/buff_shield*0.5d0
9569 C remember for the final gradient multiply sh_frac_dist_grad(j)
9570 C for side_chain by factor -2 !
9572 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9573 C sh_frac_dist_grad(j)=0.0d0
9574 C scale_fac_dist=1.0d0
9575 C print *,"jestem",scale_fac_dist,fac_help_scale,
9576 C & sh_frac_dist_grad(j)
9579 C this is what is now we have the distance scaling now volume...
9580 short=short_r_sidechain(itype(k))
9581 long=long_r_sidechain(itype(k))
9582 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9583 sinthet=short/dist_pep_side*costhet
9587 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9588 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9589 C & -short/dist_pep_side**2/costhet)
9592 costhet_grad(j)=costhet_fac*pep_side(j)
9594 C remember for the final gradient multiply costhet_grad(j)
9595 C for side_chain by factor -2 !
9596 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9597 C pep_side0pept_group is vector multiplication
9598 pep_side0pept_group=0.0d0
9600 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9602 cosalfa=(pep_side0pept_group/
9603 & (dist_pep_side*dist_side_calf))
9604 fac_alfa_sin=1.0d0-cosalfa**2
9605 fac_alfa_sin=dsqrt(fac_alfa_sin)
9606 rkprim=fac_alfa_sin*(long-short)+short
9610 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9612 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9613 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9617 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9618 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9619 &*(long-short)/fac_alfa_sin*cosalfa/
9620 &((dist_pep_side*dist_side_calf))*
9621 &((side_calf(j))-cosalfa*
9622 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9623 C cosphi_grad_long(j)=0.0d0
9624 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9625 &*(long-short)/fac_alfa_sin*cosalfa
9626 &/((dist_pep_side*dist_side_calf))*
9628 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9629 C cosphi_grad_loc(j)=0.0d0
9631 C print *,sinphi,sinthet
9632 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9635 C now the gradient...
9637 grad_shield(j,i)=grad_shield(j,i)
9638 C gradient po skalowaniu
9639 & +(sh_frac_dist_grad(j)*VofOverlap
9640 C gradient po costhet
9641 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9642 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9643 & sinphi/sinthet*costhet*costhet_grad(j)
9644 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9646 C grad_shield_side is Cbeta sidechain gradient
9647 grad_shield_side(j,ishield_list(i),i)=
9648 & (sh_frac_dist_grad(j)*(-2.0d0)
9650 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9651 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9652 & sinphi/sinthet*costhet*costhet_grad(j)
9653 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9656 grad_shield_loc(j,ishield_list(i),i)=
9657 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9658 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9659 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9663 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9665 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9666 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9667 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9671 C--------------------------------------------------------------------------
9672 double precision function tschebyshev(m,n,x,y)
9674 include "DIMENSIONS"
9676 double precision x(n),y,yy(0:maxvar),aux
9677 c Tschebyshev polynomial. Note that the first term is omitted
9678 c m=0: the constant term is included
9679 c m=1: the constant term is not included
9683 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9692 C--------------------------------------------------------------------------
9693 double precision function gradtschebyshev(m,n,x,y)
9695 include "DIMENSIONS"
9697 double precision x(n+1),y,yy(0:maxvar),aux
9698 c Tschebyshev polynomial. Note that the first term is omitted
9699 c m=0: the constant term is included
9700 c m=1: the constant term is not included
9704 yy(i)=2*y*yy(i-1)-yy(i-2)
9708 aux=aux+x(i+1)*yy(i)*(i+1)
9709 C print *, x(i+1),yy(i),i
9714 c----------------------------------------------------------------------------
9715 double precision function sscale2(r,r_cut,r0,rlamb)
9717 double precision r,gamm,r_cut,r0,rlamb,rr
9719 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9720 c write (2,*) "rr",rr
9721 if(rr.lt.r_cut-rlamb) then
9723 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9724 gamm=(rr-(r_cut-rlamb))/rlamb
9725 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9731 C-----------------------------------------------------------------------
9732 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9734 double precision r,gamm,r_cut,r0,rlamb,rr
9736 if(rr.lt.r_cut-rlamb) then
9738 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9739 gamm=(rr-(r_cut-rlamb))/rlamb
9741 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9743 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9750 c----------------------------------------------------------------------------
9751 subroutine e_saxs(Esaxs_constr)
9753 include 'DIMENSIONS'
9756 include "COMMON.SETUP"
9759 include 'COMMON.SBRIDGE'
9760 include 'COMMON.CHAIN'
9761 include 'COMMON.GEO'
9762 include 'COMMON.LOCAL'
9763 include 'COMMON.INTERACT'
9764 include 'COMMON.VAR'
9765 include 'COMMON.IOUNITS'
9766 include 'COMMON.DERIV'
9767 include 'COMMON.CONTROL'
9768 include 'COMMON.NAMES'
9769 include 'COMMON.FFIELD'
9770 include 'COMMON.LANGEVIN'
9771 include 'COMMON.SAXS'
9773 double precision Esaxs_constr
9774 integer i,iint,j,k,l
9775 double precision PgradC(maxSAXS,3,maxres),
9776 & PgradX(maxSAXS,3,maxres)
9778 double precision PgradC_(maxSAXS,3,maxres),
9779 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9781 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9782 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9783 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9784 & auxX,auxX1,CACAgrad,Cnorm
9785 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9786 double precision dist
9788 c SAXS restraint penalty function
9790 write(iout,*) "------- SAXS penalty function start -------"
9791 write (iout,*) "nsaxs",nsaxs
9792 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9793 write (iout,*) "Psaxs"
9795 write (iout,'(i5,e15.5)') i, Psaxs(i)
9798 Esaxs_constr = 0.0d0
9808 do i=iatsc_s,iatsc_e
9809 if (itype(i).eq.ntyp1) cycle
9810 do iint=1,nint_gr(i)
9811 do j=istart(i,iint),iend(i,iint)
9812 if (itype(j).eq.ntyp1) cycle
9815 dijCASC=dist(i,j+nres)
9816 dijSCCA=dist(i+nres,j)
9817 dijSCSC=dist(i+nres,j+nres)
9818 sigma2CACA=2.0d0/(pstok**2)
9819 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9820 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9821 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9824 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9825 if (itype(j).ne.10) then
9826 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9830 if (itype(i).ne.10) then
9831 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9835 if (itype(i).ne.10 .and. itype(j).ne.10) then
9836 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9840 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9842 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9844 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9845 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9846 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9847 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9850 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9851 PgradC(k,l,i) = PgradC(k,l,i)-aux
9852 PgradC(k,l,j) = PgradC(k,l,j)+aux
9854 if (itype(j).ne.10) then
9855 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9856 PgradC(k,l,i) = PgradC(k,l,i)-aux
9857 PgradC(k,l,j) = PgradC(k,l,j)+aux
9858 PgradX(k,l,j) = PgradX(k,l,j)+aux
9861 if (itype(i).ne.10) then
9862 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9863 PgradX(k,l,i) = PgradX(k,l,i)-aux
9864 PgradC(k,l,i) = PgradC(k,l,i)-aux
9865 PgradC(k,l,j) = PgradC(k,l,j)+aux
9868 if (itype(i).ne.10 .and. itype(j).ne.10) then
9869 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9870 PgradC(k,l,i) = PgradC(k,l,i)-aux
9871 PgradC(k,l,j) = PgradC(k,l,j)+aux
9872 PgradX(k,l,i) = PgradX(k,l,i)-aux
9873 PgradX(k,l,j) = PgradX(k,l,j)+aux
9879 sigma2CACA=scal_rad**2*0.25d0/
9880 & (restok(itype(j))**2+restok(itype(i))**2)
9882 IF (saxs_cutoff.eq.0) THEN
9885 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9886 Pcalc(k) = Pcalc(k)+expCACA
9887 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9889 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9890 PgradC(k,l,i) = PgradC(k,l,i)-aux
9891 PgradC(k,l,j) = PgradC(k,l,j)+aux
9895 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9898 c write (2,*) "ijk",i,j,k
9899 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9900 if (sss2.eq.0.0d0) cycle
9901 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9902 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9903 Pcalc(k) = Pcalc(k)+expCACA
9905 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9907 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9908 & ssgrad2*expCACA/sss2
9911 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9912 PgradC(k,l,i) = PgradC(k,l,i)+aux
9913 PgradC(k,l,j) = PgradC(k,l,j)-aux
9922 if (nfgtasks.gt.1) then
9923 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9924 & MPI_SUM,king,FG_COMM,IERR)
9925 if (fg_rank.eq.king) then
9927 Pcalc(k) = Pcalc_(k)
9930 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9931 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9932 if (fg_rank.eq.king) then
9936 PgradC(k,l,i) = PgradC_(k,l,i)
9942 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9943 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9944 if (fg_rank.eq.king) then
9948 PgradX(k,l,i) = PgradX_(k,l,i)
9957 if (fg_rank.eq.king) then
9961 Cnorm = Cnorm + Pcalc(k)
9963 Esaxs_constr = dlog(Cnorm)-wsaxs0
9965 if (Pcalc(k).gt.0.0d0)
9966 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9968 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9972 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9982 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9983 auxC1 = auxC1+PgradC(k,l,i)
9985 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9986 auxX1 = auxX1+PgradX(k,l,i)
9989 gsaxsC(l,i) = auxC - auxC1/Cnorm
9991 gsaxsX(l,i) = auxX - auxX1/Cnorm
9993 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9994 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
10002 c----------------------------------------------------------------------------
10003 subroutine e_saxsC(Esaxs_constr)
10005 include 'DIMENSIONS'
10008 include "COMMON.SETUP"
10011 include 'COMMON.SBRIDGE'
10012 include 'COMMON.CHAIN'
10013 include 'COMMON.GEO'
10014 include 'COMMON.LOCAL'
10015 include 'COMMON.INTERACT'
10016 include 'COMMON.VAR'
10017 include 'COMMON.IOUNITS'
10018 include 'COMMON.DERIV'
10019 include 'COMMON.CONTROL'
10020 include 'COMMON.NAMES'
10021 include 'COMMON.FFIELD'
10022 include 'COMMON.LANGEVIN'
10023 include 'COMMON.SAXS'
10025 double precision Esaxs_constr
10026 integer i,iint,j,k,l
10027 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc_,logPtot
10029 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
10031 double precision dk,dijCASPH,dijSCSPH,
10032 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
10033 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10035 c SAXS restraint penalty function
10037 write(iout,*) "------- SAXS penalty function start -------"
10038 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10039 & " isaxs_end",isaxs_end
10040 write (iout,*) "nnt",nnt," ntc",nct
10042 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10043 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10046 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10049 Esaxs_constr = 0.0d0
10051 do j=isaxs_start,isaxs_end
10063 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10065 if (itype(i).ne.10) then
10067 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10070 sigma2CA=2.0d0/pstok**2
10071 sigma2SC=4.0d0/restok(itype(i))**2
10072 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10073 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10074 Pcalc_ = Pcalc_+expCASPH+expSCSPH
10076 write(*,*) "processor i j Pcalc",
10077 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc_
10079 CASPHgrad = sigma2CA*expCASPH
10080 SCSPHgrad = sigma2SC*expSCSPH
10082 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10083 PgradX(l,i) = PgradX(l,i) + aux
10084 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10089 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc_
10090 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc_
10093 logPtot = logPtot - dlog(Pcalc_)
10094 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc_),
10095 c & " logPtot",logPtot
10098 if (nfgtasks.gt.1) then
10099 c write (iout,*) "logPtot before reduction",logPtot
10100 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10101 & MPI_SUM,king,FG_COMM,IERR)
10103 c write (iout,*) "logPtot after reduction",logPtot
10104 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10105 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10106 if (fg_rank.eq.king) then
10109 gsaxsC(l,i) = gsaxsC_(l,i)
10113 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10114 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10115 if (fg_rank.eq.king) then
10118 gsaxsX(l,i) = gsaxsX_(l,i)
10124 Esaxs_constr = logPtot
10127 C--------------------------------------------------------------------------
10128 c MODELLER restraint function
10129 subroutine e_modeller(ehomology_constr)
10130 implicit real*8 (a-h,o-z)
10131 include 'DIMENSIONS'
10132 integer nnn, i, j, k, ki, irec, l
10133 integer katy, odleglosci, test7
10134 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
10135 real*8 distance(max_template),distancek(max_template),
10136 & min_odl,godl(max_template),dih_diff(max_template)
10139 c FP - 30/10/2014 Temporary specifications for homology restraints
10141 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
10143 double precision, dimension (maxres) :: guscdiff,usc_diff
10144 double precision, dimension (max_template) ::
10145 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
10148 include 'COMMON.SBRIDGE'
10149 include 'COMMON.CHAIN'
10150 include 'COMMON.GEO'
10151 include 'COMMON.DERIV'
10152 include 'COMMON.LOCAL'
10153 include 'COMMON.INTERACT'
10154 include 'COMMON.VAR'
10155 include 'COMMON.IOUNITS'
10156 include 'COMMON.CONTROL'
10157 include 'COMMON.HOMRESTR'
10158 include 'COMMON.HOMOLOGY'
10159 include 'COMMON.SETUP'
10160 include 'COMMON.NAMES'
10162 do i=1,max_template
10163 distancek(i)=9999999.9
10168 c Pseudo-energy and gradient from homology restraints (MODELLER-like
10170 C AL 5/2/14 - Introduce list of restraints
10171 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
10173 write(iout,*) "------- dist restrs start -------"
10175 do ii = link_start_homo,link_end_homo
10179 c write (iout,*) "dij(",i,j,") =",dij
10181 do k=1,constr_homology
10182 if(.not.l_homo(k,ii)) then
10186 distance(k)=odl(k,ii)-dij
10187 c write (iout,*) "distance(",k,") =",distance(k)
10189 c For Gaussian-type Urestr
10191 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
10192 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
10193 c write (iout,*) "distancek(",k,") =",distancek(k)
10194 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
10196 c For Lorentzian-type Urestr
10198 if (waga_dist.lt.0.0d0) then
10199 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
10200 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
10201 & (distance(k)**2+sigma_odlir(k,ii)**2))
10205 c min_odl=minval(distancek)
10206 if (nexl.gt.0) then
10209 do kk=1,constr_homology
10210 if(l_homo(kk,ii)) then
10211 min_odl=distancek(kk)
10215 do kk=1,constr_homology
10216 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
10217 & min_odl=distancek(kk)
10221 c write (iout,* )"min_odl",min_odl
10223 write (iout,*) "ij dij",i,j,dij
10224 write (iout,*) "distance",(distance(k),k=1,constr_homology)
10225 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
10226 write (iout,* )"min_odl",min_odl
10231 if (waga_dist.ge.0.0d0) then
10237 do k=1,constr_homology
10238 c Nie wiem po co to liczycie jeszcze raz!
10239 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
10240 c & (2*(sigma_odl(i,j,k))**2))
10241 if(.not.l_homo(k,ii)) cycle
10242 if (waga_dist.ge.0.0d0) then
10244 c For Gaussian-type Urestr
10246 godl(k)=dexp(-distancek(k)+min_odl)
10247 odleg2=odleg2+godl(k)
10249 c For Lorentzian-type Urestr
10252 odleg2=odleg2+distancek(k)
10255 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
10256 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
10257 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
10258 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
10261 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10262 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10264 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10265 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10267 if (waga_dist.ge.0.0d0) then
10269 c For Gaussian-type Urestr
10271 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
10273 c For Lorentzian-type Urestr
10276 odleg=odleg+odleg2/constr_homology
10280 c write (iout,*) "odleg",odleg ! sum of -ln-s
10283 c For Gaussian-type Urestr
10285 if (waga_dist.ge.0.0d0) sum_godl=odleg2
10287 do k=1,constr_homology
10288 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10289 c & *waga_dist)+min_odl
10290 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
10292 if(.not.l_homo(k,ii)) cycle
10293 if (waga_dist.ge.0.0d0) then
10294 c For Gaussian-type Urestr
10296 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
10298 c For Lorentzian-type Urestr
10301 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
10302 & sigma_odlir(k,ii)**2)**2)
10304 sum_sgodl=sum_sgodl+sgodl
10306 c sgodl2=sgodl2+sgodl
10307 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
10308 c write(iout,*) "constr_homology=",constr_homology
10309 c write(iout,*) i, j, k, "TEST K"
10311 if (waga_dist.ge.0.0d0) then
10313 c For Gaussian-type Urestr
10315 grad_odl3=waga_homology(iset)*waga_dist
10316 & *sum_sgodl/(sum_godl*dij)
10318 c For Lorentzian-type Urestr
10321 c Original grad expr modified by analogy w Gaussian-type Urestr grad
10322 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
10323 grad_odl3=-waga_homology(iset)*waga_dist*
10324 & sum_sgodl/(constr_homology*dij)
10327 c grad_odl3=sum_sgodl/(sum_godl*dij)
10330 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
10331 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
10332 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10334 ccc write(iout,*) godl, sgodl, grad_odl3
10336 c grad_odl=grad_odl+grad_odl3
10339 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
10340 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
10341 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
10342 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10343 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
10344 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
10345 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
10346 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10347 c if (i.eq.25.and.j.eq.27) then
10348 c write(iout,*) "jik",jik,"i",i,"j",j
10349 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
10350 c write(iout,*) "grad_odl3",grad_odl3
10351 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
10352 c write(iout,*) "ggodl",ggodl
10353 c write(iout,*) "ghpbc(",jik,i,")",
10354 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
10359 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
10360 ccc & dLOG(odleg2),"-odleg=", -odleg
10362 enddo ! ii-loop for dist
10364 write(iout,*) "------- dist restrs end -------"
10365 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
10366 c & waga_d.eq.1.0d0) call sum_gradient
10368 c Pseudo-energy and gradient from dihedral-angle restraints from
10369 c homology templates
10370 c write (iout,*) "End of distance loop"
10373 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
10375 write(iout,*) "------- dih restrs start -------"
10376 do i=idihconstr_start_homo,idihconstr_end_homo
10377 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
10380 do i=idihconstr_start_homo,idihconstr_end_homo
10382 c betai=beta(i,i+1,i+2,i+3)
10384 c write (iout,*) "betai =",betai
10385 do k=1,constr_homology
10386 dih_diff(k)=pinorm(dih(k,i)-betai)
10387 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
10388 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
10389 c & -(6.28318-dih_diff(i,k))
10390 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
10391 c & 6.28318+dih_diff(i,k)
10393 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
10395 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
10397 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
10400 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
10403 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
10404 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
10406 write (iout,*) "i",i," betai",betai," kat2",kat2
10407 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
10409 if (kat2.le.1.0d-14) cycle
10410 kat=kat-dLOG(kat2/constr_homology)
10411 c write (iout,*) "kat",kat ! sum of -ln-s
10413 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
10414 ccc & dLOG(kat2), "-kat=", -kat
10417 c ----------------------------------------------------------------------
10419 c ----------------------------------------------------------------------
10423 do k=1,constr_homology
10425 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
10427 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
10429 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
10430 sum_sgdih=sum_sgdih+sgdih
10432 c grad_dih3=sum_sgdih/sum_gdih
10433 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
10435 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
10436 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
10437 ccc & gloc(nphi+i-3,icg)
10438 gloc(i,icg)=gloc(i,icg)+grad_dih3
10439 c if (i.eq.25) then
10440 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
10442 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
10443 ccc & gloc(nphi+i-3,icg)
10445 enddo ! i-loop for dih
10447 write(iout,*) "------- dih restrs end -------"
10450 c Pseudo-energy and gradient for theta angle restraints from
10451 c homology templates
10452 c FP 01/15 - inserted from econstr_local_test.F, loop structure
10456 c For constr_homology reference structures (FP)
10458 c Uconst_back_tot=0.0d0
10461 c Econstr_back legacy
10464 c do i=ithet_start,ithet_end
10467 c do i=loc_start,loc_end
10469 duscdiff(j,i)=0.0d0
10470 duscdiffx(j,i)=0.0d0
10476 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
10477 c write (iout,*) "waga_theta",waga_theta
10478 if (waga_theta.gt.0.0d0) then
10480 write (iout,*) "usampl",usampl
10481 write(iout,*) "------- theta restrs start -------"
10482 c do i=ithet_start,ithet_end
10483 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
10486 c write (iout,*) "maxres",maxres,"nres",nres
10488 do i=ithet_start,ithet_end
10490 c do i=1,nfrag_back
10491 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10493 c Deviation of theta angles wrt constr_homology ref structures
10495 utheta_i=0.0d0 ! argument of Gaussian for single k
10496 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10497 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
10498 c over residues in a fragment
10499 c write (iout,*) "theta(",i,")=",theta(i)
10500 do k=1,constr_homology
10502 c dtheta_i=theta(j)-thetaref(j,iref)
10503 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
10504 theta_diff(k)=thetatpl(k,i)-theta(i)
10506 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
10507 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
10508 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
10509 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
10510 c Gradient for single Gaussian restraint in subr Econstr_back
10511 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10514 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
10515 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
10519 c Gradient for multiple Gaussian restraint
10520 sum_gtheta=gutheta_i
10522 do k=1,constr_homology
10523 c New generalized expr for multiple Gaussian from Econstr_back
10524 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
10526 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
10527 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
10530 c Final value of gradient using same var as in Econstr_back
10531 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
10532 & *waga_homology(iset)
10533 c dutheta(i)=sum_sgtheta/sum_gtheta
10535 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
10537 Eval=Eval-dLOG(gutheta_i/constr_homology)
10538 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
10539 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
10540 c Uconst_back=Uconst_back+utheta(i)
10541 enddo ! (i-loop for theta)
10543 write(iout,*) "------- theta restrs end -------"
10547 c Deviation of local SC geometry
10549 c Separation of two i-loops (instructed by AL - 11/3/2014)
10551 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
10552 c write (iout,*) "waga_d",waga_d
10555 write(iout,*) "------- SC restrs start -------"
10556 write (iout,*) "Initial duscdiff,duscdiffx"
10557 do i=loc_start,loc_end
10558 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
10559 & (duscdiffx(jik,i),jik=1,3)
10562 do i=loc_start,loc_end
10563 usc_diff_i=0.0d0 ! argument of Gaussian for single k
10564 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10565 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
10566 c write(iout,*) "xxtab, yytab, zztab"
10567 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
10568 do k=1,constr_homology
10570 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10571 c Original sign inverted for calc of gradients (s. Econstr_back)
10572 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10573 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10574 c write(iout,*) "dxx, dyy, dzz"
10575 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10577 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
10578 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
10579 c uscdiffk(k)=usc_diff(i)
10580 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
10581 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
10582 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10583 c & xxref(j),yyref(j),zzref(j)
10588 c Generalized expression for multiple Gaussian acc to that for a single
10589 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
10591 c Original implementation
10592 c sum_guscdiff=guscdiff(i)
10594 c sum_sguscdiff=0.0d0
10595 c do k=1,constr_homology
10596 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
10597 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
10598 c sum_sguscdiff=sum_sguscdiff+sguscdiff
10601 c Implementation of new expressions for gradient (Jan. 2015)
10603 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
10605 do k=1,constr_homology
10607 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
10608 c before. Now the drivatives should be correct
10610 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10611 c Original sign inverted for calc of gradients (s. Econstr_back)
10612 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10613 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10615 c New implementation
10617 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
10618 & sigma_d(k,i) ! for the grad wrt r'
10619 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
10622 c New implementation
10623 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
10625 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
10626 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
10627 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
10628 duscdiff(jik,i)=duscdiff(jik,i)+
10629 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
10630 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
10631 duscdiffx(jik,i)=duscdiffx(jik,i)+
10632 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
10633 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
10636 write(iout,*) "jik",jik,"i",i
10637 write(iout,*) "dxx, dyy, dzz"
10638 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10639 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
10640 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
10641 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
10642 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
10643 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
10644 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
10645 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
10646 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
10647 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
10648 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
10649 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
10650 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
10651 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
10652 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
10659 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
10660 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
10662 c write (iout,*) i," uscdiff",uscdiff(i)
10664 c Put together deviations from local geometry
10666 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
10667 c & wfrag_back(3,i,iset)*uscdiff(i)
10668 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
10669 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
10670 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
10671 c Uconst_back=Uconst_back+usc_diff(i)
10673 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
10675 c New implment: multiplied by sum_sguscdiff
10678 enddo ! (i-loop for dscdiff)
10683 write(iout,*) "------- SC restrs end -------"
10684 write (iout,*) "------ After SC loop in e_modeller ------"
10685 do i=loc_start,loc_end
10686 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
10687 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
10689 if (waga_theta.eq.1.0d0) then
10690 write (iout,*) "in e_modeller after SC restr end: dutheta"
10691 do i=ithet_start,ithet_end
10692 write (iout,*) i,dutheta(i)
10695 if (waga_d.eq.1.0d0) then
10696 write (iout,*) "e_modeller after SC loop: duscdiff/x"
10698 write (iout,*) i,(duscdiff(j,i),j=1,3)
10699 write (iout,*) i,(duscdiffx(j,i),j=1,3)
10704 c Total energy from homology restraints
10706 write (iout,*) "odleg",odleg," kat",kat
10707 write (iout,*) "odleg",odleg," kat",kat
10708 write (iout,*) "Eval",Eval," Erot",Erot
10709 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
10710 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
10711 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
10714 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
10716 c ehomology_constr=odleg+kat
10718 c For Lorentzian-type Urestr
10721 if (waga_dist.ge.0.0d0) then
10723 c For Gaussian-type Urestr
10725 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
10726 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10727 ehomology_constr=waga_dist*odleg+waga_angle*kat+
10728 & waga_theta*Eval+waga_d*Erot
10729 c write (iout,*) "ehomology_constr=",ehomology_constr
10732 c For Lorentzian-type Urestr
10734 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
10735 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10736 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
10737 & waga_theta*Eval+waga_d*Erot
10738 c write (iout,*) "ehomology_constr=",ehomology_constr
10741 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
10742 & "Eval",waga_theta,eval,
10743 & "Erot",waga_d,Erot
10744 write (iout,*) "ehomology_constr",ehomology_constr
10748 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
10749 747 format(a12,i4,i4,i4,f8.3,f8.3)
10750 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
10751 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
10752 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
10753 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)