1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
9 cMS$ATTRIBUTES C :: proc_proc
12 include 'COMMON.IOUNITS'
13 double precision energia(0:max_ene),energia1(0:max_ene+1)
14 include 'COMMON.FFIELD'
15 include 'COMMON.DERIV'
16 include 'COMMON.INTERACT'
17 include 'COMMON.SBRIDGE'
18 include 'COMMON.CHAIN'
19 include 'COMMON.SHIELD'
20 include 'COMMON.CONTROL'
21 include 'COMMON.TORCNSTR'
23 double precision fact(6)
24 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
26 cd print *,'nnt=',nnt,' nct=',nct
28 C Compute the side-chain and electrostatic interaction energy
30 goto (101,102,103,104,105) ipot
31 C Lennard-Jones potential.
32 101 call elj(evdw,evdw_t)
33 cd print '(a)','Exit ELJ'
35 C Lennard-Jones-Kihara potential (shifted).
36 102 call eljk(evdw,evdw_t)
38 C Berne-Pechukas potential (dilated LJ, angular dependence).
39 103 call ebp(evdw,evdw_t)
41 C Gay-Berne potential (shifted LJ, angular dependence).
42 104 call egb(evdw,evdw_t)
44 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
45 105 call egbv(evdw,evdw_t)
47 C Calculate electrostatic (H-bonding) energy of the main chain.
50 c write (iout,*) "Sidechain"
53 if (shield_mode.eq.1) then
55 else if (shield_mode.eq.2) then
58 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
59 c write(iout,*) 'po eelec'
62 C Calculate excluded-volume interaction energy between peptide groups
65 call escp(evdw2,evdw2_14)
67 c Calculate the bond-stretching energy
71 C write (iout,*) "estr",estr
73 C Calculate the disulfide-bridge and other energy and the contributions
74 C from other distance constraints.
75 cd print *,'Calling EHPB'
77 cd print *,'EHPB exitted succesfully.'
79 C Calculate the virtual-bond-angle energy.
81 C print *,'Bend energy finished.'
83 if (tor_mode.eq.0) then
86 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
94 if (with_theta_constr) call etheta_constr(ethetacnstr)
95 c call ebend(ebe,ethetacnstr)
96 cd print *,'Bend energy finished.'
98 C Calculate the SC local energy.
101 C print *,'SCLOC energy finished.'
103 C Calculate the virtual-bond torsional energy.
105 if (wtor.gt.0.0d0) then
106 if (tor_mode.eq.0) then
107 call etor(etors,fact(1))
109 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
111 call etor_kcc(etors,fact(1))
117 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
118 c print *,"Processor",myrank," computed Utor"
120 C 6/23/01 Calculate double-torsional energy
122 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
123 call etor_d(etors_d,fact(2))
127 c print *,"Processor",myrank," computed Utord"
129 call eback_sc_corr(esccor)
131 if (wliptran.gt.0) then
132 call Eliptransfer(eliptran)
138 C 12/1/95 Multi-body terms
142 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
143 & .or. wturn6.gt.0.0d0) then
144 c write(iout,*)"calling multibody_eello"
145 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
146 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
147 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
154 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
155 c write (iout,*) "Calling multibody_hbond"
156 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
159 c write (iout,*) "NSAXS",nsaxs
160 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
161 call e_saxs(Esaxs_constr)
162 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
163 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
164 call e_saxsC(Esaxs_constr)
165 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
169 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
170 if (constr_homology.ge.1) then
171 call e_modeller(ehomology_constr)
173 ehomology_constr=0.0d0
176 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
178 C BARTEK for dfa test!
179 if (wdfa_dist.gt.0) call edfad(edfadis)
180 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
181 if (wdfa_tor.gt.0) call edfat(edfator)
182 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
183 if (wdfa_nei.gt.0) call edfan(edfanei)
184 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
185 if (wdfa_beta.gt.0) call edfab(edfabet)
186 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
190 if (shield_mode.gt.0) then
191 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
193 & +fact(1)*wvdwpp*evdw1
194 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
196 & +wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
197 & +wcorr6*fact(5)*ecorr6
198 & +wturn4*fact(3)*eello_turn4
199 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
200 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
201 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
202 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
203 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
206 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
208 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
209 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
210 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
211 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
212 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
213 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
214 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
215 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
219 if (shield_mode.gt.0) then
220 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
221 & +welec*fact(1)*(ees+evdw1)
222 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
223 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
224 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
225 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
226 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
227 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
228 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
229 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
232 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
233 & +welec*fact(1)*(ees+evdw1)
234 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
235 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
236 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
237 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
238 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
239 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
240 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
241 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
248 energia(2)=evdw2-evdw2_14
265 energia(8)=eello_turn3
266 energia(9)=eello_turn4
275 energia(20)=edihcnstr
278 energia(24)=ethetacnstr
279 energia(26)=esaxs_constr
280 energia(27)=ehomology_constr
288 if (isnan(etot).ne.0) energia(0)=1.0d+99
290 if (isnan(etot)) energia(0)=1.0d+99
295 idumm=proc_proc(etot,i)
297 call proc_proc(etot,i)
299 if(i.eq.1)energia(0)=1.0d+99
305 call enerprint(energia,fact)
309 C Sum up the components of the Cartesian gradient.
314 if (shield_mode.eq.0) then
315 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
316 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
318 & wstrain*ghpbc(j,i)+
319 & wcorr*fact(3)*gradcorr(j,i)+
320 & wel_loc*fact(2)*gel_loc(j,i)+
321 & wturn3*fact(2)*gcorr3_turn(j,i)+
322 & wturn4*fact(3)*gcorr4_turn(j,i)+
323 & wcorr5*fact(4)*gradcorr5(j,i)+
324 & wcorr6*fact(5)*gradcorr6(j,i)+
325 & wturn6*fact(5)*gcorr6_turn(j,i)+
326 & wsccor*fact(2)*gsccorc(j,i)
327 & +wliptran*gliptranc(j,i)+
328 & wdfa_dist*gdfad(j,i)+
329 & wdfa_tor*gdfat(j,i)+
330 & wdfa_nei*gdfan(j,i)+
331 & wdfa_beta*gdfab(j,i)
332 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
334 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
335 & wsccor*fact(2)*gsccorx(j,i)
336 & +wliptran*gliptranx(j,i)
338 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
339 & +fact(1)*wscp*gvdwc_scp(j,i)+
340 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
342 & wstrain*ghpbc(j,i)+
343 & wcorr*fact(3)*gradcorr(j,i)+
344 & wel_loc*fact(2)*gel_loc(j,i)+
345 & wturn3*fact(2)*gcorr3_turn(j,i)+
346 & wturn4*fact(3)*gcorr4_turn(j,i)+
347 & wcorr5*fact(4)*gradcorr5(j,i)+
348 & wcorr6*fact(5)*gradcorr6(j,i)+
349 & wturn6*fact(5)*gcorr6_turn(j,i)+
350 & wsccor*fact(2)*gsccorc(j,i)
351 & +wliptran*gliptranc(j,i)
352 & +welec*gshieldc(j,i)
353 & +welec*gshieldc_loc(j,i)
354 & +wcorr*gshieldc_ec(j,i)
355 & +wcorr*gshieldc_loc_ec(j,i)
356 & +wturn3*gshieldc_t3(j,i)
357 & +wturn3*gshieldc_loc_t3(j,i)
358 & +wturn4*gshieldc_t4(j,i)
359 & +wturn4*gshieldc_loc_t4(j,i)
360 & +wel_loc*gshieldc_ll(j,i)
361 & +wel_loc*gshieldc_loc_ll(j,i)+
362 & wdfa_dist*gdfad(j,i)+
363 & wdfa_tor*gdfat(j,i)+
364 & wdfa_nei*gdfan(j,i)+
365 & wdfa_beta*gdfab(j,i)
366 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
367 & +fact(1)*wscp*gradx_scp(j,i)+
369 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
370 & wsccor*fact(2)*gsccorx(j,i)
371 & +wliptran*gliptranx(j,i)
372 & +welec*gshieldx(j,i)
373 & +wcorr*gshieldx_ec(j,i)
374 & +wturn3*gshieldx_t3(j,i)
375 & +wturn4*gshieldx_t4(j,i)
376 & +wel_loc*gshieldx_ll(j,i)
384 if (shield_mode.eq.0) then
385 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
386 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
388 & wcorr*fact(3)*gradcorr(j,i)+
389 & wel_loc*fact(2)*gel_loc(j,i)+
390 & wturn3*fact(2)*gcorr3_turn(j,i)+
391 & wturn4*fact(3)*gcorr4_turn(j,i)+
392 & wcorr5*fact(4)*gradcorr5(j,i)+
393 & wcorr6*fact(5)*gradcorr6(j,i)+
394 & wturn6*fact(5)*gcorr6_turn(j,i)+
395 & wsccor*fact(2)*gsccorc(j,i)
396 & +wliptran*gliptranc(j,i)+
397 & wdfa_dist*gdfad(j,i)+
398 & wdfa_tor*gdfat(j,i)+
399 & wdfa_nei*gdfan(j,i)+
400 & wdfa_beta*gdfab(j,i)
401 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
403 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
404 & wsccor*fact(1)*gsccorx(j,i)
405 & +wliptran*gliptranx(j,i)
407 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
408 & fact(1)*wscp*gvdwc_scp(j,i)+
409 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
411 & wcorr*fact(3)*gradcorr(j,i)+
412 & wel_loc*fact(2)*gel_loc(j,i)+
413 & wturn3*fact(2)*gcorr3_turn(j,i)+
414 & wturn4*fact(3)*gcorr4_turn(j,i)+
415 & wcorr5*fact(4)*gradcorr5(j,i)+
416 & wcorr6*fact(5)*gradcorr6(j,i)+
417 & wturn6*fact(5)*gcorr6_turn(j,i)+
418 & wsccor*fact(2)*gsccorc(j,i)
419 & +wliptran*gliptranc(j,i)
420 & +welec*gshieldc(j,i)
421 & +welec*gshieldc_loc(j,i)
422 & +wcorr*gshieldc_ec(j,i)
423 & +wcorr*gshieldc_loc_ec(j,i)
424 & +wturn3*gshieldc_t3(j,i)
425 & +wturn3*gshieldc_loc_t3(j,i)
426 & +wturn4*gshieldc_t4(j,i)
427 & +wturn4*gshieldc_loc_t4(j,i)
428 & +wel_loc*gshieldc_ll(j,i)
429 & +wel_loc*gshieldc_loc_ll(j,i)+
430 & wdfa_dist*gdfad(j,i)+
431 & wdfa_tor*gdfat(j,i)+
432 & wdfa_nei*gdfan(j,i)+
433 & wdfa_beta*gdfab(j,i)
434 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
435 & fact(1)*wscp*gradx_scp(j,i)+
437 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
438 & wsccor*fact(1)*gsccorx(j,i)
439 & +wliptran*gliptranx(j,i)
440 & +welec*gshieldx(j,i)
441 & +wcorr*gshieldx_ec(j,i)
442 & +wturn3*gshieldx_t3(j,i)
443 & +wturn4*gshieldx_t4(j,i)
444 & +wel_loc*gshieldx_ll(j,i)
452 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
453 & +wcorr5*fact(4)*g_corr5_loc(i)
454 & +wcorr6*fact(5)*g_corr6_loc(i)
455 & +wturn4*fact(3)*gel_loc_turn4(i)
456 & +wturn3*fact(2)*gel_loc_turn3(i)
457 & +wturn6*fact(5)*gel_loc_turn6(i)
458 & +wel_loc*fact(2)*gel_loc_loc(i)
459 c & +wsccor*fact(1)*gsccor_loc(i)
460 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
463 if (dyn_ss) call dyn_set_nss
466 C------------------------------------------------------------------------
467 subroutine enerprint(energia,fact)
468 implicit real*8 (a-h,o-z)
470 include 'COMMON.IOUNITS'
471 include 'COMMON.FFIELD'
472 include 'COMMON.SBRIDGE'
473 include 'COMMON.CONTROL'
474 double precision energia(0:max_ene),fact(6)
476 evdw=energia(1)+fact(6)*energia(21)
478 evdw2=energia(2)+energia(17)
490 eello_turn3=energia(8)
491 eello_turn4=energia(9)
492 eello_turn6=energia(10)
499 edihcnstr=energia(20)
501 ethetacnstr=energia(24)
504 ehomology_constr=energia(27)
506 edfadis = energia(28)
507 edfator = energia(29)
508 edfanei = energia(30)
509 edfabet = energia(31)
511 write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
512 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
513 & etors_d,wtor_d*fact(2),ehpb,wstrain,
515 & ecorr,wcorr*fact(3),
516 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
519 & wel_loc*fact(2),eello_turn3,wturn3*fact(2),
520 & eello_turn4,wturn4*fact(3),
522 & eello_turn6,wturn6*fact(5),
524 & esccor,wsccor*fact(1),edihcnstr,
525 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
526 & etube,wtube,esaxs,wsaxs,ehomology_constr,
527 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
530 10 format (/'Virtual-chain energies:'//
531 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
532 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
533 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
534 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
535 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
536 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
537 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
538 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
539 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
540 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
541 & ' (SS bridges & dist. cnstr.)'/
543 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
544 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
545 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
547 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
548 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
549 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
551 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
553 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
554 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
555 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
556 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
557 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
558 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
559 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
560 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
561 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
562 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
563 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
564 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
565 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
566 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
567 & 'ETOT= ',1pE16.6,' (total)')
570 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
571 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
572 & etors_d,wtor_d*fact(2),ehpb,
574 & wstrain,ecorr,wcorr*fact(3),
575 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
577 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
578 & eello_turn4,wturn4*fact(3),
580 & eello_turn6,wturn6*fact(5),
582 & esccor,wsccor*fact(1),edihcnstr,
583 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
584 & etube,wtube,esaxs,wsaxs,ehomology_constr,
585 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
588 10 format (/'Virtual-chain energies:'//
589 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
590 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
591 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
592 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
593 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
594 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
595 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
596 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
597 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
598 & ' (SS bridges & dist. restr.)'/
600 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
601 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
602 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
604 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
605 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
606 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
608 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
610 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
611 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
612 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
613 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
614 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
615 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
616 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
617 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
618 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
619 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
620 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
621 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
622 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
623 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
624 & 'ETOT= ',1pE16.6,' (total)')
628 C-----------------------------------------------------------------------
629 subroutine elj(evdw,evdw_t)
631 C This subroutine calculates the interaction energy of nonbonded side chains
632 C assuming the LJ potential of interaction.
634 implicit real*8 (a-h,o-z)
636 include "DIMENSIONS.COMPAR"
637 parameter (accur=1.0d-10)
640 include 'COMMON.LOCAL'
641 include 'COMMON.CHAIN'
642 include 'COMMON.DERIV'
643 include 'COMMON.INTERACT'
644 include 'COMMON.TORSION'
645 include 'COMMON.SBRIDGE'
646 include 'COMMON.NAMES'
647 include 'COMMON.IOUNITS'
649 include 'COMMON.CONTACTS'
650 include 'COMMON.CONTMAT'
655 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
659 c eneps_temp(j,i)=0.0d0
668 if (itypi.eq.ntyp1) cycle
669 itypi1=iabs(itype(i+1))
676 C Calculate SC interaction energy.
679 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
680 cd & 'iend=',iend(i,iint)
681 do j=istart(i,iint),iend(i,iint)
683 if (itypj.eq.ntyp1) cycle
687 C Change 12/1/95 to calculate four-body interactions
688 rij=xj*xj+yj*yj+zj*zj
692 if (sss1.eq.0.0d0) cycle
693 sssgrad1=sscagrad(sqrij)
694 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
695 eps0ij=eps(itypi,itypj)
700 ij=icant(itypi,itypj)
702 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
703 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
706 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
707 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
708 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
709 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
710 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
711 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
712 if (bb.gt.0.0d0) then
713 evdw=evdw+sss1*evdwij
715 evdw_t=evdw_t+sss1*evdwij
719 C Calculate the components of the gradient in DC and X
721 fac=-rrij*(e1+evdwij)*sss1
722 & +evdwij*sssgrad1/sqrij/expon
727 gvdwx(k,i)=gvdwx(k,i)-gg(k)
728 gvdwx(k,j)=gvdwx(k,j)+gg(k)
732 gvdwc(l,k)=gvdwc(l,k)+gg(l)
738 C 12/1/95, revised on 5/20/97
740 C Calculate the contact function. The ith column of the array JCONT will
741 C contain the numbers of atoms that make contacts with the atom I (of numbers
742 C greater than I). The arrays FACONT and GACONT will contain the values of
743 C the contact function and its derivative.
745 C Uncomment next line, if the correlation interactions include EVDW explicitly.
746 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
747 C Uncomment next line, if the correlation interactions are contact function only
748 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
750 sigij=sigma(itypi,itypj)
751 r0ij=rs0(itypi,itypj)
753 C Check whether the SC's are not too far to make a contact.
756 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
757 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
759 if (fcont.gt.0.0D0) then
760 C If the SC-SC distance if close to sigma, apply spline.
761 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
762 cAdam & fcont1,fprimcont1)
763 cAdam fcont1=1.0d0-fcont1
764 cAdam if (fcont1.gt.0.0d0) then
765 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
766 cAdam fcont=fcont*fcont1
768 C Uncomment following 4 lines to have the geometric average of the epsilon0's
769 cga eps0ij=1.0d0/dsqrt(eps0ij)
771 cga gg(k)=gg(k)*eps0ij
773 cga eps0ij=-evdwij*eps0ij
774 C Uncomment for AL's type of SC correlation interactions.
776 num_conti=num_conti+1
778 facont(num_conti,i)=fcont*eps0ij
779 fprimcont=eps0ij*fprimcont/rij
781 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
782 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
783 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
784 C Uncomment following 3 lines for Skolnick's type of SC correlation.
785 gacont(1,num_conti,i)=-fprimcont*xj
786 gacont(2,num_conti,i)=-fprimcont*yj
787 gacont(3,num_conti,i)=-fprimcont*zj
788 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
789 cd write (iout,'(2i3,3f10.5)')
790 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
798 num_cont(i)=num_conti
804 gvdwc(j,i)=expon*gvdwc(j,i)
805 gvdwx(j,i)=expon*gvdwx(j,i)
809 C******************************************************************************
813 C To save time, the factor of EXPON has been extracted from ALL components
814 C of GVDWC and GRADX. Remember to multiply them by this factor before further
817 C******************************************************************************
820 C-----------------------------------------------------------------------------
821 subroutine eljk(evdw,evdw_t)
823 C This subroutine calculates the interaction energy of nonbonded side chains
824 C assuming the LJK potential of interaction.
826 implicit real*8 (a-h,o-z)
828 include "DIMENSIONS.COMPAR"
831 include 'COMMON.LOCAL'
832 include 'COMMON.CHAIN'
833 include 'COMMON.DERIV'
834 include 'COMMON.INTERACT'
835 include 'COMMON.IOUNITS'
836 include 'COMMON.NAMES'
841 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
844 c eneps_temp(j,i)=0.0d0
851 if (itypi.eq.ntyp1) cycle
852 itypi1=iabs(itype(i+1))
857 C Calculate SC interaction energy.
860 do j=istart(i,iint),iend(i,iint)
862 if (itypj.eq.ntyp1) cycle
866 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
868 e_augm=augm(itypi,itypj)*fac_augm
872 if (sss1.eq.0.0d0) cycle
873 sssgrad1=sscagrad(rij)
874 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
875 fac=r_shift_inv**expon
879 ij=icant(itypi,itypj)
880 c eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
881 c & /dabs(eps(itypi,itypj))
882 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
883 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
884 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
885 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
886 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
887 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
888 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
889 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
890 if (bb.gt.0.0d0) then
891 evdw=evdw+evdwij*sss1
893 evdw_t=evdw_t+evdwij*sss1
897 C Calculate the components of the gradient in DC and X
899 fac=(-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2))*sss1
900 & +evdwij*sssgrad1*r_inv_ij/expon
905 gvdwx(k,i)=gvdwx(k,i)-gg(k)
906 gvdwx(k,j)=gvdwx(k,j)+gg(k)
910 gvdwc(l,k)=gvdwc(l,k)+gg(l)
920 gvdwc(j,i)=expon*gvdwc(j,i)
921 gvdwx(j,i)=expon*gvdwx(j,i)
927 C-----------------------------------------------------------------------------
928 subroutine ebp(evdw,evdw_t)
930 C This subroutine calculates the interaction energy of nonbonded side chains
931 C assuming the Berne-Pechukas potential of interaction.
933 implicit real*8 (a-h,o-z)
935 include "DIMENSIONS.COMPAR"
938 include 'COMMON.LOCAL'
939 include 'COMMON.CHAIN'
940 include 'COMMON.DERIV'
941 include 'COMMON.NAMES'
942 include 'COMMON.INTERACT'
943 include 'COMMON.IOUNITS'
944 include 'COMMON.CALC'
946 c double precision rrsave(maxdim)
952 c eneps_temp(j,i)=0.0d0
957 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
958 c if (icall.eq.0) then
966 if (itypi.eq.ntyp1) cycle
967 itypi1=iabs(itype(i+1))
971 dxi=dc_norm(1,nres+i)
972 dyi=dc_norm(2,nres+i)
973 dzi=dc_norm(3,nres+i)
974 dsci_inv=vbld_inv(i+nres)
976 C Calculate SC interaction energy.
979 do j=istart(i,iint),iend(i,iint)
982 if (itypj.eq.ntyp1) cycle
983 dscj_inv=vbld_inv(j+nres)
984 chi1=chi(itypi,itypj)
985 chi2=chi(itypj,itypi)
992 alf12=0.5D0*(alf1+alf2)
993 C For diagnostics only!!!
1006 dxj=dc_norm(1,nres+j)
1007 dyj=dc_norm(2,nres+j)
1008 dzj=dc_norm(3,nres+j)
1009 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1010 cd if (icall.eq.0) then
1016 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1018 C Calculate whole angle-dependent part of epsilon and contributions
1019 C to its derivatives
1020 fac=(rrij*sigsq)**expon2
1023 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1024 eps2der=evdwij*eps3rt
1025 eps3der=evdwij*eps2rt
1026 evdwij=evdwij*eps2rt*eps3rt
1027 ij=icant(itypi,itypj)
1028 aux=eps1*eps2rt**2*eps3rt**2
1029 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
1030 c & /dabs(eps(itypi,itypj))
1031 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
1032 if (bb.gt.0.0d0) then
1035 evdw_t=evdw_t+evdwij
1039 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1041 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1042 & restyp(itypi),i,restyp(itypj),j,
1043 & epsi,sigm,chi1,chi2,chip1,chip2,
1044 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1045 & om1,om2,om12,1.0D0/dsqrt(rrij),
1048 C Calculate gradient components.
1049 e1=e1*eps1*eps2rt**2*eps3rt**2
1050 fac=-expon*(e1+evdwij)
1053 C Calculate radial part of the gradient
1057 C Calculate the angular part of the gradient and sum add the contributions
1058 C to the appropriate components of the Cartesian gradient.
1067 C-----------------------------------------------------------------------------
1068 subroutine egb(evdw,evdw_t)
1070 C This subroutine calculates the interaction energy of nonbonded side chains
1071 C assuming the Gay-Berne potential of interaction.
1073 implicit real*8 (a-h,o-z)
1074 include 'DIMENSIONS'
1075 include "DIMENSIONS.COMPAR"
1076 include 'COMMON.GEO'
1077 include 'COMMON.VAR'
1078 include 'COMMON.LOCAL'
1079 include 'COMMON.CHAIN'
1080 include 'COMMON.DERIV'
1081 include 'COMMON.NAMES'
1082 include 'COMMON.INTERACT'
1083 include 'COMMON.IOUNITS'
1084 include 'COMMON.CALC'
1085 include 'COMMON.SBRIDGE'
1088 integer icant,xshift,yshift,zshift
1092 c eneps_temp(j,i)=0.0d0
1095 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1099 c if (icall.gt.0) lprn=.true.
1101 do i=iatsc_s,iatsc_e
1102 itypi=iabs(itype(i))
1103 if (itypi.eq.ntyp1) cycle
1104 itypi1=iabs(itype(i+1))
1108 C returning the ith atom to box
1110 if (xi.lt.0) xi=xi+boxxsize
1112 if (yi.lt.0) yi=yi+boxysize
1114 if (zi.lt.0) zi=zi+boxzsize
1115 if ((zi.gt.bordlipbot)
1116 &.and.(zi.lt.bordliptop)) then
1117 C the energy transfer exist
1118 if (zi.lt.buflipbot) then
1119 C what fraction I am in
1121 & ((zi-bordlipbot)/lipbufthick)
1122 C lipbufthick is thickenes of lipid buffore
1123 sslipi=sscalelip(fracinbuf)
1124 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1125 elseif (zi.gt.bufliptop) then
1126 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1127 sslipi=sscalelip(fracinbuf)
1128 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1138 dxi=dc_norm(1,nres+i)
1139 dyi=dc_norm(2,nres+i)
1140 dzi=dc_norm(3,nres+i)
1141 dsci_inv=vbld_inv(i+nres)
1143 C Calculate SC interaction energy.
1145 do iint=1,nint_gr(i)
1146 do j=istart(i,iint),iend(i,iint)
1147 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1148 call dyn_ssbond_ene(i,j,evdwij)
1150 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1151 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1152 C triple bond artifac removal
1153 do k=j+1,iend(i,iint)
1154 C search over all next residues
1155 if (dyn_ss_mask(k)) then
1156 C check if they are cysteins
1157 C write(iout,*) 'k=',k
1158 call triple_ssbond_ene(i,j,k,evdwij)
1159 C call the energy function that removes the artifical triple disulfide
1160 C bond the soubroutine is located in ssMD.F
1162 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1163 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1164 endif!dyn_ss_mask(k)
1168 itypj=iabs(itype(j))
1169 if (itypj.eq.ntyp1) cycle
1170 dscj_inv=vbld_inv(j+nres)
1171 sig0ij=sigma(itypi,itypj)
1172 chi1=chi(itypi,itypj)
1173 chi2=chi(itypj,itypi)
1180 alf12=0.5D0*(alf1+alf2)
1181 C For diagnostics only!!!
1194 C returning jth atom to box
1196 if (xj.lt.0) xj=xj+boxxsize
1198 if (yj.lt.0) yj=yj+boxysize
1200 if (zj.lt.0) zj=zj+boxzsize
1201 if ((zj.gt.bordlipbot)
1202 &.and.(zj.lt.bordliptop)) then
1203 C the energy transfer exist
1204 if (zj.lt.buflipbot) then
1205 C what fraction I am in
1207 & ((zj-bordlipbot)/lipbufthick)
1208 C lipbufthick is thickenes of lipid buffore
1209 sslipj=sscalelip(fracinbuf)
1210 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1211 elseif (zj.gt.bufliptop) then
1212 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1213 sslipj=sscalelip(fracinbuf)
1214 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1223 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1224 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1225 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1226 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1227 C if (aa.ne.aa_aq(itypi,itypj)) then
1229 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1230 C & bb_aq(itypi,itypj)-bb,
1234 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1235 C checking the distance
1236 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1241 C finding the closest
1245 xj=xj_safe+xshift*boxxsize
1246 yj=yj_safe+yshift*boxysize
1247 zj=zj_safe+zshift*boxzsize
1248 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1249 if(dist_temp.lt.dist_init) then
1259 if (subchap.eq.1) then
1269 dxj=dc_norm(1,nres+j)
1270 dyj=dc_norm(2,nres+j)
1271 dzj=dc_norm(3,nres+j)
1272 c write (iout,*) i,j,xj,yj,zj
1273 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1275 sss=sscale(1.0d0/rij))
1276 sssgrad=sscagrad(1.0d0/rij)
1277 if (sss.le.0.0) cycle
1278 C Calculate angle-dependent terms of energy and contributions to their
1283 sig=sig0ij*dsqrt(sigsq)
1284 rij_shift=1.0D0/rij-sig+sig0ij
1285 C I hate to put IF's in the loops, but here don't have another choice!!!!
1286 if (rij_shift.le.0.0D0) then
1291 c---------------------------------------------------------------
1292 rij_shift=1.0D0/rij_shift
1293 fac=rij_shift**expon
1296 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1297 eps2der=evdwij*eps3rt
1298 eps3der=evdwij*eps2rt
1299 evdwij=evdwij*eps2rt*eps3rt
1301 evdw=evdw+evdwij*sss
1303 evdw_t=evdw_t+evdwij*sss
1305 ij=icant(itypi,itypj)
1306 aux=eps1*eps2rt**2*eps3rt**2
1307 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1308 c & /dabs(eps(itypi,itypj))
1309 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1310 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1311 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1312 c & aux*e2/eps(itypi,itypj)
1314 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1318 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1319 & restyp(itypi),i,restyp(itypj),j,
1320 & epsi,sigm,chi1,chi2,chip1,chip2,
1321 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1322 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1324 write (iout,*) "partial sum", evdw, evdw_t
1329 C Calculate gradient components.
1330 e1=e1*eps1*eps2rt**2*eps3rt**2
1331 fac=-expon*(e1+evdwij)*rij_shift
1334 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1335 C Calculate the radial part of the gradient
1339 C Calculate angular part of the gradient.
1342 C write(iout,*) "partial sum", evdw, evdw_t
1349 C-----------------------------------------------------------------------------
1350 subroutine egbv(evdw,evdw_t)
1352 C This subroutine calculates the interaction energy of nonbonded side chains
1353 C assuming the Gay-Berne-Vorobjev potential of interaction.
1355 implicit real*8 (a-h,o-z)
1356 include 'DIMENSIONS'
1357 include "DIMENSIONS.COMPAR"
1358 include 'COMMON.GEO'
1359 include 'COMMON.VAR'
1360 include 'COMMON.LOCAL'
1361 include 'COMMON.CHAIN'
1362 include 'COMMON.DERIV'
1363 include 'COMMON.NAMES'
1364 include 'COMMON.INTERACT'
1365 include 'COMMON.IOUNITS'
1366 include 'COMMON.CALC'
1367 common /srutu/ icall
1373 c eneps_temp(j,i)=0.0d0
1378 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1381 c if (icall.gt.0) lprn=.true.
1383 do i=iatsc_s,iatsc_e
1384 itypi=iabs(itype(i))
1385 if (itypi.eq.ntyp1) cycle
1386 itypi1=iabs(itype(i+1))
1390 dxi=dc_norm(1,nres+i)
1391 dyi=dc_norm(2,nres+i)
1392 dzi=dc_norm(3,nres+i)
1393 dsci_inv=vbld_inv(i+nres)
1395 C Calculate SC interaction energy.
1397 do iint=1,nint_gr(i)
1398 do j=istart(i,iint),iend(i,iint)
1400 itypj=iabs(itype(j))
1401 if (itypj.eq.ntyp1) cycle
1402 dscj_inv=vbld_inv(j+nres)
1403 sig0ij=sigma(itypi,itypj)
1404 r0ij=r0(itypi,itypj)
1405 chi1=chi(itypi,itypj)
1406 chi2=chi(itypj,itypi)
1413 alf12=0.5D0*(alf1+alf2)
1414 C For diagnostics only!!!
1427 dxj=dc_norm(1,nres+j)
1428 dyj=dc_norm(2,nres+j)
1429 dzj=dc_norm(3,nres+j)
1430 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1432 sss=sscale(1.0d0/rij)
1433 if (sss.eq.0.0d0) cycle
1434 sssgrad=sscagrad(1.0d0/rij)
1435 C Calculate angle-dependent terms of energy and contributions to their
1439 sig=sig0ij*dsqrt(sigsq)
1440 rij_shift=1.0D0/rij-sig+r0ij
1441 C I hate to put IF's in the loops, but here don't have another choice!!!!
1442 if (rij_shift.le.0.0D0) then
1447 c---------------------------------------------------------------
1448 rij_shift=1.0D0/rij_shift
1449 fac=rij_shift**expon
1452 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1453 eps2der=evdwij*eps3rt
1454 eps3der=evdwij*eps2rt
1455 fac_augm=rrij**expon
1456 e_augm=augm(itypi,itypj)*fac_augm
1457 evdwij=evdwij*eps2rt*eps3rt
1458 if (bb.gt.0.0d0) then
1459 evdw=evdw+(evdwij+e_augm)*sss
1461 evdw_t=evdw_t+(evdwij+e_augm)*sss
1463 ij=icant(itypi,itypj)
1464 aux=eps1*eps2rt**2*eps3rt**2
1465 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1466 c & /dabs(eps(itypi,itypj))
1467 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1468 c eneps_temp(ij)=eneps_temp(ij)
1469 c & +(evdwij+e_augm)/eps(itypi,itypj)
1471 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1472 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1473 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1474 c & restyp(itypi),i,restyp(itypj),j,
1475 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1476 c & chi1,chi2,chip1,chip2,
1477 c & eps1,eps2rt**2,eps3rt**2,
1478 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1482 C Calculate gradient components.
1483 e1=e1*eps1*eps2rt**2*eps3rt**2
1484 fac=-expon*(e1+evdwij)*rij_shift
1486 fac=rij*fac-2*expon*rrij*e_augm
1487 fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
1488 C Calculate the radial part of the gradient
1492 C Calculate angular part of the gradient.
1500 C-----------------------------------------------------------------------------
1501 subroutine sc_angular
1502 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1503 C om12. Called by ebp, egb, and egbv.
1505 include 'COMMON.CALC'
1509 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1510 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1511 om12=dxi*dxj+dyi*dyj+dzi*dzj
1513 C Calculate eps1(om12) and its derivative in om12
1514 faceps1=1.0D0-om12*chiom12
1515 faceps1_inv=1.0D0/faceps1
1516 eps1=dsqrt(faceps1_inv)
1517 C Following variable is eps1*deps1/dom12
1518 eps1_om12=faceps1_inv*chiom12
1519 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1524 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1525 sigsq=1.0D0-facsig*faceps1_inv
1526 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1527 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1528 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1529 C Calculate eps2 and its derivatives in om1, om2, and om12.
1532 chipom12=chip12*om12
1533 facp=1.0D0-om12*chipom12
1535 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1536 C Following variable is the square root of eps2
1537 eps2rt=1.0D0-facp1*facp_inv
1538 C Following three variables are the derivatives of the square root of eps
1539 C in om1, om2, and om12.
1540 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1541 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1542 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1543 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1544 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1545 C Calculate whole angle-dependent part of epsilon and contributions
1546 C to its derivatives
1549 C----------------------------------------------------------------------------
1551 implicit real*8 (a-h,o-z)
1552 include 'DIMENSIONS'
1553 include 'COMMON.CHAIN'
1554 include 'COMMON.DERIV'
1555 include 'COMMON.CALC'
1556 double precision dcosom1(3),dcosom2(3)
1557 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1558 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1559 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1560 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1562 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1563 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1566 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1569 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1570 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1571 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1572 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1573 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1574 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1577 C Calculate the components of the gradient in DC and X
1581 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1586 c------------------------------------------------------------------------------
1587 subroutine vec_and_deriv
1588 implicit real*8 (a-h,o-z)
1589 include 'DIMENSIONS'
1590 include 'COMMON.IOUNITS'
1591 include 'COMMON.GEO'
1592 include 'COMMON.VAR'
1593 include 'COMMON.LOCAL'
1594 include 'COMMON.CHAIN'
1595 include 'COMMON.VECTORS'
1596 include 'COMMON.DERIV'
1597 include 'COMMON.INTERACT'
1598 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1599 C Compute the local reference systems. For reference system (i), the
1600 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1601 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1603 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1604 if (i.eq.nres-1) then
1605 C Case of the last full residue
1606 C Compute the Z-axis
1607 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1608 costh=dcos(pi-theta(nres))
1609 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1610 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1616 C Compute the derivatives of uz
1618 uzder(2,1,1)=-dc_norm(3,i-1)
1619 uzder(3,1,1)= dc_norm(2,i-1)
1620 uzder(1,2,1)= dc_norm(3,i-1)
1622 uzder(3,2,1)=-dc_norm(1,i-1)
1623 uzder(1,3,1)=-dc_norm(2,i-1)
1624 uzder(2,3,1)= dc_norm(1,i-1)
1627 uzder(2,1,2)= dc_norm(3,i)
1628 uzder(3,1,2)=-dc_norm(2,i)
1629 uzder(1,2,2)=-dc_norm(3,i)
1631 uzder(3,2,2)= dc_norm(1,i)
1632 uzder(1,3,2)= dc_norm(2,i)
1633 uzder(2,3,2)=-dc_norm(1,i)
1636 C Compute the Y-axis
1639 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1642 C Compute the derivatives of uy
1645 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1646 & -dc_norm(k,i)*dc_norm(j,i-1)
1647 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1649 uyder(j,j,1)=uyder(j,j,1)-costh
1650 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1655 uygrad(l,k,j,i)=uyder(l,k,j)
1656 uzgrad(l,k,j,i)=uzder(l,k,j)
1660 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1661 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1662 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1663 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1667 C Compute the Z-axis
1668 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1669 costh=dcos(pi-theta(i+2))
1670 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1675 C Compute the derivatives of uz
1677 uzder(2,1,1)=-dc_norm(3,i+1)
1678 uzder(3,1,1)= dc_norm(2,i+1)
1679 uzder(1,2,1)= dc_norm(3,i+1)
1681 uzder(3,2,1)=-dc_norm(1,i+1)
1682 uzder(1,3,1)=-dc_norm(2,i+1)
1683 uzder(2,3,1)= dc_norm(1,i+1)
1686 uzder(2,1,2)= dc_norm(3,i)
1687 uzder(3,1,2)=-dc_norm(2,i)
1688 uzder(1,2,2)=-dc_norm(3,i)
1690 uzder(3,2,2)= dc_norm(1,i)
1691 uzder(1,3,2)= dc_norm(2,i)
1692 uzder(2,3,2)=-dc_norm(1,i)
1695 C Compute the Y-axis
1698 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1701 C Compute the derivatives of uy
1704 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1705 & -dc_norm(k,i)*dc_norm(j,i+1)
1706 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1708 uyder(j,j,1)=uyder(j,j,1)-costh
1709 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1714 uygrad(l,k,j,i)=uyder(l,k,j)
1715 uzgrad(l,k,j,i)=uzder(l,k,j)
1719 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1720 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1721 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1722 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1728 vbld_inv_temp(1)=vbld_inv(i+1)
1729 if (i.lt.nres-1) then
1730 vbld_inv_temp(2)=vbld_inv(i+2)
1732 vbld_inv_temp(2)=vbld_inv(i)
1737 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1738 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1746 C--------------------------------------------------------------------------
1747 subroutine set_matrices
1748 implicit real*8 (a-h,o-z)
1749 include 'DIMENSIONS'
1753 integer status(MPI_STATUS_SIZE)
1755 include 'COMMON.IOUNITS'
1756 include 'COMMON.GEO'
1757 include 'COMMON.VAR'
1758 include 'COMMON.LOCAL'
1759 include 'COMMON.CHAIN'
1760 include 'COMMON.DERIV'
1761 include 'COMMON.INTERACT'
1762 include 'COMMON.CONTACTS'
1763 include 'COMMON.TORSION'
1764 include 'COMMON.VECTORS'
1765 include 'COMMON.FFIELD'
1766 include 'COMMON.CORRMAT'
1767 double precision auxvec(2),auxmat(2,2)
1769 C Compute the virtual-bond-torsional-angle dependent quantities needed
1770 C to calculate the el-loc multibody terms of various order.
1772 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1774 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1775 iti = itype2loc(itype(i-2))
1779 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1780 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1781 iti1 = itype2loc(itype(i-1))
1786 cost1=dcos(theta(i-1))
1787 sint1=dsin(theta(i-1))
1789 sint1cub=sint1sq*sint1
1790 sint1cost1=2*sint1*cost1
1792 write (iout,*) "bnew1",i,iti
1793 write (iout,*) (bnew1(k,1,iti),k=1,3)
1794 write (iout,*) (bnew1(k,2,iti),k=1,3)
1795 write (iout,*) "bnew2",i,iti
1796 write (iout,*) (bnew2(k,1,iti),k=1,3)
1797 write (iout,*) (bnew2(k,2,iti),k=1,3)
1800 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1802 gtb1(k,i-2)=cost1*b1k-sint1sq*
1803 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1804 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1806 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1807 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1810 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1811 cc(1,k,i-2)=sint1sq*aux
1812 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1813 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1814 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1815 dd(1,k,i-2)=sint1sq*aux
1816 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1817 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1819 cc(2,1,i-2)=cc(1,2,i-2)
1820 cc(2,2,i-2)=-cc(1,1,i-2)
1821 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1822 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1823 dd(2,1,i-2)=dd(1,2,i-2)
1824 dd(2,2,i-2)=-dd(1,1,i-2)
1825 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1826 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1829 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1830 EE(l,k,i-2)=sint1sq*aux
1832 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1835 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1836 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1837 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1838 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1840 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1841 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1842 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1844 c b1tilde(1,i-2)=b1(1,i-2)
1845 c b1tilde(2,i-2)=-b1(2,i-2)
1846 c b2tilde(1,i-2)=b2(1,i-2)
1847 c b2tilde(2,i-2)=-b2(2,i-2)
1849 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1850 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1851 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1852 write (iout,*) 'theta=', theta(i-1)
1855 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1856 c iti = itype2loc(itype(i-2))
1860 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1861 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1862 c iti1 = itype2loc(itype(i-1))
1872 CC(k,l,i-2)=ccold(k,l,iti)
1873 DD(k,l,i-2)=ddold(k,l,iti)
1874 EE(k,l,i-2)=eeold(k,l,iti)
1878 b1tilde(1,i-2)= b1(1,i-2)
1879 b1tilde(2,i-2)=-b1(2,i-2)
1880 b2tilde(1,i-2)= b2(1,i-2)
1881 b2tilde(2,i-2)=-b2(2,i-2)
1883 Ctilde(1,1,i-2)= CC(1,1,i-2)
1884 Ctilde(1,2,i-2)= CC(1,2,i-2)
1885 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1886 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1888 Dtilde(1,1,i-2)= DD(1,1,i-2)
1889 Dtilde(1,2,i-2)= DD(1,2,i-2)
1890 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1891 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1892 c write(iout,*) "i",i," iti",iti
1893 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1894 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1897 if (i .lt. nres+1) then
1934 if (i .gt. 3 .and. i .lt. nres+1) then
1935 obrot_der(1,i-2)=-sin1
1936 obrot_der(2,i-2)= cos1
1937 Ugder(1,1,i-2)= sin1
1938 Ugder(1,2,i-2)=-cos1
1939 Ugder(2,1,i-2)=-cos1
1940 Ugder(2,2,i-2)=-sin1
1943 obrot2_der(1,i-2)=-dwasin2
1944 obrot2_der(2,i-2)= dwacos2
1945 Ug2der(1,1,i-2)= dwasin2
1946 Ug2der(1,2,i-2)=-dwacos2
1947 Ug2der(2,1,i-2)=-dwacos2
1948 Ug2der(2,2,i-2)=-dwasin2
1950 obrot_der(1,i-2)=0.0d0
1951 obrot_der(2,i-2)=0.0d0
1952 Ugder(1,1,i-2)=0.0d0
1953 Ugder(1,2,i-2)=0.0d0
1954 Ugder(2,1,i-2)=0.0d0
1955 Ugder(2,2,i-2)=0.0d0
1956 obrot2_der(1,i-2)=0.0d0
1957 obrot2_der(2,i-2)=0.0d0
1958 Ug2der(1,1,i-2)=0.0d0
1959 Ug2der(1,2,i-2)=0.0d0
1960 Ug2der(2,1,i-2)=0.0d0
1961 Ug2der(2,2,i-2)=0.0d0
1963 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1964 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1965 iti = itype2loc(itype(i-2))
1969 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1970 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1971 iti1 = itype2loc(itype(i-1))
1975 cd write (iout,*) '*******i',i,' iti1',iti
1976 cd write (iout,*) 'b1',b1(:,iti)
1977 cd write (iout,*) 'b2',b2(:,iti)
1978 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1979 c if (i .gt. iatel_s+2) then
1980 if (i .gt. nnt+2) then
1981 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1983 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1984 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1986 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1987 c & EE(1,2,iti),EE(2,2,i)
1988 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1989 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1990 c write(iout,*) "Macierz EUG",
1991 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
1994 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
1996 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
1997 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
1998 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1999 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
2000 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
2012 DtUg2(l,k,i-2)=0.0d0
2016 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2017 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2019 muder(k,i-2)=Ub2der(k,i-2)
2021 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2022 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2023 if (itype(i-1).le.ntyp) then
2024 iti1 = itype2loc(itype(i-1))
2032 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2035 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2036 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2037 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2038 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2039 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2040 & ((ee(l,k,i-2),l=1,2),k=1,2)
2042 cd write (iout,*) 'mu1',mu1(:,i-2)
2043 cd write (iout,*) 'mu2',mu2(:,i-2)
2045 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2048 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2049 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2050 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2051 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2052 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2054 C Vectors and matrices dependent on a single virtual-bond dihedral.
2055 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2056 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2057 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2058 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2059 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2061 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2062 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2063 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2064 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2070 C Matrices dependent on two consecutive virtual-bond dihedrals.
2071 C The order of matrices is from left to right.
2072 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2075 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2077 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2078 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2080 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2081 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2083 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2084 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2085 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2092 C--------------------------------------------------------------------------
2093 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2095 C This subroutine calculates the average interaction energy and its gradient
2096 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2097 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2098 C The potential depends both on the distance of peptide-group centers and on
2099 C the orientation of the CA-CA virtual bonds.
2101 implicit real*8 (a-h,o-z)
2105 include 'DIMENSIONS'
2106 include 'COMMON.CONTROL'
2107 include 'COMMON.IOUNITS'
2108 include 'COMMON.GEO'
2109 include 'COMMON.VAR'
2110 include 'COMMON.LOCAL'
2111 include 'COMMON.CHAIN'
2112 include 'COMMON.DERIV'
2113 include 'COMMON.INTERACT'
2115 include 'COMMON.CONTACTS'
2116 include 'COMMON.CONTMAP'
2118 include 'COMMON.CORRMAT'
2119 include 'COMMON.TORSION'
2120 include 'COMMON.VECTORS'
2121 include 'COMMON.FFIELD'
2122 include 'COMMON.TIME1'
2123 include 'COMMON.SPLITELE'
2124 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2125 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2126 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2127 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2128 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2129 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2131 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2133 double precision scal_el /1.0d0/
2135 double precision scal_el /0.5d0/
2138 C 13-go grudnia roku pamietnego...
2139 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2140 & 0.0d0,1.0d0,0.0d0,
2141 & 0.0d0,0.0d0,1.0d0/
2142 cd write(iout,*) 'In EELEC'
2144 cd write(iout,*) 'Type',i
2145 cd write(iout,*) 'B1',B1(:,i)
2146 cd write(iout,*) 'B2',B2(:,i)
2147 cd write(iout,*) 'CC',CC(:,:,i)
2148 cd write(iout,*) 'DD',DD(:,:,i)
2149 cd write(iout,*) 'EE',EE(:,:,i)
2151 cd call check_vecgrad
2153 if (icheckgrad.eq.1) then
2155 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2157 dc_norm(k,i)=dc(k,i)*fac
2159 c write (iout,*) 'i',i,' fac',fac
2162 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2163 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2164 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2165 c call vec_and_deriv
2171 time_mat=time_mat+MPI_Wtime()-time01
2175 cd write (iout,*) 'i=',i
2177 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2180 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2181 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2196 cd print '(a)','Enter EELEC'
2197 c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2200 gel_loc_loc(i)=0.0d0
2205 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2207 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2209 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2210 do i=iturn3_start,iturn3_end
2212 C write(iout,*) "tu jest i",i
2213 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2214 C changes suggested by Ana to avoid out of bounds
2215 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2216 c & .or.((i+4).gt.nres)
2217 c & .or.((i-1).le.0)
2218 C end of changes by Ana
2219 C dobra zmiana wycofana
2220 & .or. itype(i+2).eq.ntyp1
2221 & .or. itype(i+3).eq.ntyp1) cycle
2222 C Adam: Instructions below will switch off existing interactions
2224 c if(itype(i-1).eq.ntyp1)cycle
2226 c if(i.LT.nres-3)then
2227 c if (itype(i+4).eq.ntyp1) cycle
2232 dx_normi=dc_norm(1,i)
2233 dy_normi=dc_norm(2,i)
2234 dz_normi=dc_norm(3,i)
2235 xmedi=c(1,i)+0.5d0*dxi
2236 ymedi=c(2,i)+0.5d0*dyi
2237 zmedi=c(3,i)+0.5d0*dzi
2238 xmedi=mod(xmedi,boxxsize)
2239 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2240 ymedi=mod(ymedi,boxysize)
2241 if (ymedi.lt.0) ymedi=ymedi+boxysize
2242 zmedi=mod(zmedi,boxzsize)
2243 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2245 call eelecij(i,i+2,ees,evdw1,eel_loc)
2246 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2248 num_cont_hb(i)=num_conti
2251 do i=iturn4_start,iturn4_end
2253 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2254 C changes suggested by Ana to avoid out of bounds
2255 c & .or.((i+5).gt.nres)
2256 c & .or.((i-1).le.0)
2257 C end of changes suggested by Ana
2258 & .or. itype(i+3).eq.ntyp1
2259 & .or. itype(i+4).eq.ntyp1
2260 c & .or. itype(i+5).eq.ntyp1
2261 c & .or. itype(i).eq.ntyp1
2262 c & .or. itype(i-1).eq.ntyp1
2267 dx_normi=dc_norm(1,i)
2268 dy_normi=dc_norm(2,i)
2269 dz_normi=dc_norm(3,i)
2270 xmedi=c(1,i)+0.5d0*dxi
2271 ymedi=c(2,i)+0.5d0*dyi
2272 zmedi=c(3,i)+0.5d0*dzi
2273 C Return atom into box, boxxsize is size of box in x dimension
2275 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2276 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2277 C Condition for being inside the proper box
2278 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2279 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2283 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2284 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2285 C Condition for being inside the proper box
2286 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2287 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2291 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2292 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2293 C Condition for being inside the proper box
2294 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2295 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2298 xmedi=mod(xmedi,boxxsize)
2299 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2300 ymedi=mod(ymedi,boxysize)
2301 if (ymedi.lt.0) ymedi=ymedi+boxysize
2302 zmedi=mod(zmedi,boxzsize)
2303 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2306 num_conti=num_cont_hb(i)
2308 c write(iout,*) "JESTEM W PETLI"
2309 call eelecij(i,i+3,ees,evdw1,eel_loc)
2310 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2311 & call eturn4(i,eello_turn4)
2313 num_cont_hb(i)=num_conti
2316 C Loop over all neighbouring boxes
2321 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2324 do i=iatel_s,iatel_e
2327 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2328 C changes suggested by Ana to avoid out of bounds
2329 c & .or.((i+2).gt.nres)
2330 c & .or.((i-1).le.0)
2331 C end of changes by Ana
2332 c & .or. itype(i+2).eq.ntyp1
2333 c & .or. itype(i-1).eq.ntyp1
2338 dx_normi=dc_norm(1,i)
2339 dy_normi=dc_norm(2,i)
2340 dz_normi=dc_norm(3,i)
2341 xmedi=c(1,i)+0.5d0*dxi
2342 ymedi=c(2,i)+0.5d0*dyi
2343 zmedi=c(3,i)+0.5d0*dzi
2344 xmedi=mod(xmedi,boxxsize)
2345 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2346 ymedi=mod(ymedi,boxysize)
2347 if (ymedi.lt.0) ymedi=ymedi+boxysize
2348 zmedi=mod(zmedi,boxzsize)
2349 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2350 C xmedi=xmedi+xshift*boxxsize
2351 C ymedi=ymedi+yshift*boxysize
2352 C zmedi=zmedi+zshift*boxzsize
2354 C Return tom into box, boxxsize is size of box in x dimension
2356 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2357 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2358 C Condition for being inside the proper box
2359 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2360 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2364 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2365 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2366 C Condition for being inside the proper box
2367 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2368 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2372 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2373 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2374 cC Condition for being inside the proper box
2375 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2376 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2380 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2382 num_conti=num_cont_hb(i)
2385 do j=ielstart(i),ielend(i)
2387 C write (iout,*) i,j
2389 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2390 C changes suggested by Ana to avoid out of bounds
2391 c & .or.((j+2).gt.nres)
2392 c & .or.((j-1).le.0)
2393 C end of changes by Ana
2394 c & .or.itype(j+2).eq.ntyp1
2395 c & .or.itype(j-1).eq.ntyp1
2397 call eelecij(i,j,ees,evdw1,eel_loc)
2400 num_cont_hb(i)=num_conti
2407 c write (iout,*) "Number of loop steps in EELEC:",ind
2409 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2410 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2412 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2413 ccc eel_loc=eel_loc+eello_turn3
2414 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2417 C-------------------------------------------------------------------------------
2418 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2419 implicit real*8 (a-h,o-z)
2420 include 'DIMENSIONS'
2424 include 'COMMON.CONTROL'
2425 include 'COMMON.IOUNITS'
2426 include 'COMMON.GEO'
2427 include 'COMMON.VAR'
2428 include 'COMMON.LOCAL'
2429 include 'COMMON.CHAIN'
2430 include 'COMMON.DERIV'
2431 include 'COMMON.INTERACT'
2433 include 'COMMON.CONTACTS'
2434 include 'COMMON.CONTMAP'
2436 include 'COMMON.CORRMAT'
2437 include 'COMMON.TORSION'
2438 include 'COMMON.VECTORS'
2439 include 'COMMON.FFIELD'
2440 include 'COMMON.TIME1'
2441 include 'COMMON.SPLITELE'
2442 include 'COMMON.SHIELD'
2443 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2444 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2445 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2446 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2447 & gmuij2(4),gmuji2(4)
2448 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2449 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2451 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2453 double precision scal_el /1.0d0/
2455 double precision scal_el /0.5d0/
2458 C 13-go grudnia roku pamietnego...
2459 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2460 & 0.0d0,1.0d0,0.0d0,
2461 & 0.0d0,0.0d0,1.0d0/
2462 integer xshift,yshift,zshift
2463 c time00=MPI_Wtime()
2464 cd write (iout,*) "eelecij",i,j
2468 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2469 aaa=app(iteli,itelj)
2470 bbb=bpp(iteli,itelj)
2471 ael6i=ael6(iteli,itelj)
2472 ael3i=ael3(iteli,itelj)
2476 dx_normj=dc_norm(1,j)
2477 dy_normj=dc_norm(2,j)
2478 dz_normj=dc_norm(3,j)
2479 C xj=c(1,j)+0.5D0*dxj-xmedi
2480 C yj=c(2,j)+0.5D0*dyj-ymedi
2481 C zj=c(3,j)+0.5D0*dzj-zmedi
2486 if (xj.lt.0) xj=xj+boxxsize
2488 if (yj.lt.0) yj=yj+boxysize
2490 if (zj.lt.0) zj=zj+boxzsize
2491 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2492 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2500 xj=xj_safe+xshift*boxxsize
2501 yj=yj_safe+yshift*boxysize
2502 zj=zj_safe+zshift*boxzsize
2503 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2504 if(dist_temp.lt.dist_init) then
2514 if (isubchap.eq.1) then
2523 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2525 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2526 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2527 C Condition for being inside the proper box
2528 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2529 c & (xj.lt.((-0.5d0)*boxxsize))) then
2533 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2534 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2535 C Condition for being inside the proper box
2536 c if ((yj.gt.((0.5d0)*boxysize)).or.
2537 c & (yj.lt.((-0.5d0)*boxysize))) then
2541 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2542 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2543 C Condition for being inside the proper box
2544 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2545 c & (zj.lt.((-0.5d0)*boxzsize))) then
2548 C endif !endPBC condintion
2552 rij=xj*xj+yj*yj+zj*zj
2554 sss=sscale(sqrt(rij))
2555 if (sss.eq.0.0d0) return
2556 sssgrad=sscagrad(sqrt(rij))
2557 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2558 c & " rlamb",rlamb," sss",sss
2559 c if (sss.gt.0.0d0) then
2565 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2566 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2567 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2568 fac=cosa-3.0D0*cosb*cosg
2570 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2571 if (j.eq.i+2) ev1=scal_el*ev1
2576 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2580 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2581 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2582 if (shield_mode.gt.0) then
2585 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2586 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2595 evdw1=evdw1+evdwij*sss
2596 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2597 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2598 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2599 cd & xmedi,ymedi,zmedi,xj,yj,zj
2601 if (energy_dec) then
2602 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2604 &,iteli,itelj,aaa,evdw1,sss
2605 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2606 &fac_shield(i),fac_shield(j)
2610 C Calculate contributions to the Cartesian gradient.
2613 facvdw=-6*rrmij*(ev1+evdwij)*sss
2614 facel=-3*rrmij*(el1+eesij)
2621 * Radial derivatives. First process both termini of the fragment (i,j)
2627 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2628 & (shield_mode.gt.0)) then
2630 do ilist=1,ishield_list(i)
2631 iresshield=shield_list(ilist,i)
2633 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2635 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2637 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2638 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2639 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2640 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2641 C if (iresshield.gt.i) then
2642 C do ishi=i+1,iresshield-1
2643 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2644 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2648 C do ishi=iresshield,i
2649 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2650 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2656 do ilist=1,ishield_list(j)
2657 iresshield=shield_list(ilist,j)
2659 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2661 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2663 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2664 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2666 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2667 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2668 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2669 C if (iresshield.gt.j) then
2670 C do ishi=j+1,iresshield-1
2671 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2672 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2676 C do ishi=iresshield,j
2677 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2678 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2685 gshieldc(k,i)=gshieldc(k,i)+
2686 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2687 gshieldc(k,j)=gshieldc(k,j)+
2688 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2689 gshieldc(k,i-1)=gshieldc(k,i-1)+
2690 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2691 gshieldc(k,j-1)=gshieldc(k,j-1)+
2692 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2697 c ghalf=0.5D0*ggg(k)
2698 c gelc(k,i)=gelc(k,i)+ghalf
2699 c gelc(k,j)=gelc(k,j)+ghalf
2701 c 9/28/08 AL Gradient compotents will be summed only at the end
2702 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2704 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2705 C & +grad_shield(k,j)*eesij/fac_shield(j)
2706 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2707 C & +grad_shield(k,i)*eesij/fac_shield(i)
2708 C gelc_long(k,i-1)=gelc_long(k,i-1)
2709 C & +grad_shield(k,i)*eesij/fac_shield(i)
2710 C gelc_long(k,j-1)=gelc_long(k,j-1)
2711 C & +grad_shield(k,j)*eesij/fac_shield(j)
2713 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2716 * Loop over residues i+1 thru j-1.
2720 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2723 if (sss.gt.0.0) then
2724 facvdw=facvdw+sssgrad*rmij*evdwij
2734 c ghalf=0.5D0*ggg(k)
2735 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2736 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2738 c 9/28/08 AL Gradient compotents will be summed only at the end
2740 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2741 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2744 * Loop over residues i+1 thru j-1.
2748 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2757 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2758 & +(evdwij+eesij)*sssgrad*rrmij
2763 * Radial derivatives. First process both termini of the fragment (i,j)
2767 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2769 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2771 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2773 c ghalf=0.5D0*ggg(k)
2774 c gelc(k,i)=gelc(k,i)+ghalf
2775 c gelc(k,j)=gelc(k,j)+ghalf
2777 c 9/28/08 AL Gradient compotents will be summed only at the end
2779 gelc_long(k,j)=gelc(k,j)+ggg(k)
2780 gelc_long(k,i)=gelc(k,i)-ggg(k)
2783 * Loop over residues i+1 thru j-1.
2787 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2790 c 9/28/08 AL Gradient compotents will be summed only at the end
2791 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2792 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2793 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2795 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2796 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2804 ecosa=2.0D0*fac3*fac1+fac4
2807 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2808 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2810 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2811 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2813 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2814 cd & (dcosg(k),k=1,3)
2816 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2817 & fac_shield(i)**2*fac_shield(j)**2
2820 c ghalf=0.5D0*ggg(k)
2821 c gelc(k,i)=gelc(k,i)+ghalf
2822 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2823 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2824 c gelc(k,j)=gelc(k,j)+ghalf
2825 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2826 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2830 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2833 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2836 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2837 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2838 & *fac_shield(i)**2*fac_shield(j)**2
2840 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2841 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2842 & *fac_shield(i)**2*fac_shield(j)**2
2843 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2844 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2846 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2851 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2852 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2853 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2855 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2856 C energy of a peptide unit is assumed in the form of a second-order
2857 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2858 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2859 C are computed for EVERY pair of non-contiguous peptide groups.
2862 if (j.lt.nres-1) then
2874 muij(kkk)=mu(k,i)*mu(l,j)
2875 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2878 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2879 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2880 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2881 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2882 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2883 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2889 write (iout,*) 'EELEC: i',i,' j',j
2890 write (iout,*) 'j',j,' j1',j1,' j2',j2
2891 write(iout,*) 'muij',muij
2892 write (iout,*) "uy",uy(:,i)
2893 write (iout,*) "uz",uz(:,j)
2894 write (iout,*) "erij",erij
2896 ury=scalar(uy(1,i),erij)
2897 urz=scalar(uz(1,i),erij)
2898 vry=scalar(uy(1,j),erij)
2899 vrz=scalar(uz(1,j),erij)
2900 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2901 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2902 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2903 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2904 fac=dsqrt(-ael6i)*r3ij
2909 cd write (iout,'(4i5,4f10.5)')
2910 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2911 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2912 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2913 cd & uy(:,j),uz(:,j)
2914 cd write (iout,'(4f10.5)')
2915 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2916 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2917 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2918 cd write (iout,'(9f10.5/)')
2919 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2920 C Derivatives of the elements of A in virtual-bond vectors
2922 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2924 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2925 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2926 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2927 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2928 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2929 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2930 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2931 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2932 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2933 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2934 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2935 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2937 C Compute radial contributions to the gradient
2955 C Add the contributions coming from er
2958 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2959 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2960 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2961 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2964 C Derivatives in DC(i)
2965 cgrad ghalf1=0.5d0*agg(k,1)
2966 cgrad ghalf2=0.5d0*agg(k,2)
2967 cgrad ghalf3=0.5d0*agg(k,3)
2968 cgrad ghalf4=0.5d0*agg(k,4)
2969 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2970 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2971 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2972 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2973 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2974 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2975 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2976 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2977 C Derivatives in DC(i+1)
2978 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2979 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2980 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2981 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2982 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2983 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2984 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2985 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2986 C Derivatives in DC(j)
2987 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2988 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2989 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2990 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2991 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2992 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2993 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2994 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2995 C Derivatives in DC(j+1) or DC(nres-1)
2996 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2997 & -3.0d0*vryg(k,3)*ury)
2998 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2999 & -3.0d0*vrzg(k,3)*ury)
3000 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3001 & -3.0d0*vryg(k,3)*urz)
3002 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3003 & -3.0d0*vrzg(k,3)*urz)
3004 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3006 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3021 aggi(k,l)=-aggi(k,l)
3022 aggi1(k,l)=-aggi1(k,l)
3023 aggj(k,l)=-aggj(k,l)
3024 aggj1(k,l)=-aggj1(k,l)
3028 if (j.lt.nres-1) then
3034 aggi(k,l)=-aggi(k,l)
3035 aggi1(k,l)=-aggi1(k,l)
3036 aggj(k,l)=-aggj(k,l)
3037 aggj1(k,l)=-aggj1(k,l)
3048 aggi(k,l)=-aggi(k,l)
3049 aggi1(k,l)=-aggi1(k,l)
3050 aggj(k,l)=-aggj(k,l)
3051 aggj1(k,l)=-aggj1(k,l)
3056 IF (wel_loc.gt.0.0d0) THEN
3057 C Contribution to the local-electrostatic energy coming from the i-j pair
3058 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3061 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
3063 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
3064 & " wel_loc",wel_loc
3066 if (shield_mode.eq.0) then
3073 eel_loc_ij=eel_loc_ij
3074 & *fac_shield(i)*fac_shield(j)
3075 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3076 & 'eelloc',i,j,eel_loc_ij
3077 c if (eel_loc_ij.ne.0)
3078 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3079 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3081 eel_loc=eel_loc+eel_loc_ij*sss
3082 C Now derivative over eel_loc
3084 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3085 & (shield_mode.gt.0)) then
3088 do ilist=1,ishield_list(i)
3089 iresshield=shield_list(ilist,i)
3091 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
3094 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3096 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
3097 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3101 do ilist=1,ishield_list(j)
3102 iresshield=shield_list(ilist,j)
3104 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
3107 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3109 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3110 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3117 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3118 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3119 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3120 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3121 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3122 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3123 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3124 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3129 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3130 c & ' eel_loc_ij',eel_loc_ij
3131 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3132 C Calculate patrial derivative for theta angle
3134 geel_loc_ij=(a22*gmuij1(1)
3138 & *fac_shield(i)*fac_shield(j)*sss
3139 c write(iout,*) "derivative over thatai"
3140 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3142 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3143 & geel_loc_ij*wel_loc
3144 c write(iout,*) "derivative over thatai-1"
3145 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3152 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3153 & geel_loc_ij*wel_loc
3154 & *fac_shield(i)*fac_shield(j)*sss
3156 c Derivative over j residue
3157 geel_loc_ji=a22*gmuji1(1)
3161 c write(iout,*) "derivative over thataj"
3162 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3165 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3166 & geel_loc_ji*wel_loc
3167 & *fac_shield(i)*fac_shield(j)
3174 c write(iout,*) "derivative over thataj-1"
3175 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3177 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3178 & geel_loc_ji*wel_loc
3179 & *fac_shield(i)*fac_shield(j)*sss
3181 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3183 C Partial derivatives in virtual-bond dihedral angles gamma
3185 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3186 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3187 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3188 & *fac_shield(i)*fac_shield(j)
3190 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3191 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3192 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3193 & *fac_shield(i)*fac_shield(j)
3194 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3195 aux=eel_loc_ij/sss*sssgrad*rmij
3200 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3201 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3202 & *fac_shield(i)*fac_shield(j)*sss
3203 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3204 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3205 cgrad ghalf=0.5d0*ggg(l)
3206 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3207 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3211 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3214 C Remaining derivatives of eello
3216 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3217 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3218 & *fac_shield(i)*fac_shield(j)
3220 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3221 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3222 & *fac_shield(i)*fac_shield(j)
3224 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3225 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3226 & *fac_shield(i)*fac_shield(j)
3228 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3229 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3230 & *fac_shield(i)*fac_shield(j)
3237 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3238 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3240 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3241 & .and. num_conti.le.maxconts) then
3242 c write (iout,*) i,j," entered corr"
3244 C Calculate the contact function. The ith column of the array JCONT will
3245 C contain the numbers of atoms that make contacts with the atom I (of numbers
3246 C greater than I). The arrays FACONT and GACONT will contain the values of
3247 C the contact function and its derivative.
3248 c r0ij=1.02D0*rpp(iteli,itelj)
3249 c r0ij=1.11D0*rpp(iteli,itelj)
3250 r0ij=2.20D0*rpp(iteli,itelj)
3251 c r0ij=1.55D0*rpp(iteli,itelj)
3252 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3253 if (fcont.gt.0.0D0) then
3254 num_conti=num_conti+1
3255 if (num_conti.gt.maxconts) then
3256 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3257 & ' will skip next contacts for this conf.'
3259 jcont_hb(num_conti,i)=j
3260 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3261 cd & " jcont_hb",jcont_hb(num_conti,i)
3262 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3263 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3264 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3266 d_cont(num_conti,i)=rij
3267 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3268 C --- Electrostatic-interaction matrix ---
3269 a_chuj(1,1,num_conti,i)=a22
3270 a_chuj(1,2,num_conti,i)=a23
3271 a_chuj(2,1,num_conti,i)=a32
3272 a_chuj(2,2,num_conti,i)=a33
3273 C --- Gradient of rij
3276 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3283 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3284 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3285 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3286 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3287 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3293 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3294 C Calculate contact energies
3296 wij=cosa-3.0D0*cosb*cosg
3299 c fac3=dsqrt(-ael6i)/r0ij**3
3300 fac3=dsqrt(-ael6i)*r3ij
3301 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3302 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3303 if (ees0tmp.gt.0) then
3304 ees0pij=dsqrt(ees0tmp)
3308 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3309 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3310 if (ees0tmp.gt.0) then
3311 ees0mij=dsqrt(ees0tmp)
3316 if (shield_mode.eq.0) then
3320 ees0plist(num_conti,i)=j
3321 C fac_shield(i)=0.4d0
3322 C fac_shield(j)=0.6d0
3324 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3325 & *fac_shield(i)*fac_shield(j)
3326 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3327 & *fac_shield(i)*fac_shield(j)
3328 C Diagnostics. Comment out or remove after debugging!
3329 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3330 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3331 c ees0m(num_conti,i)=0.0D0
3333 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3334 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3335 C Angular derivatives of the contact function
3337 ees0pij1=fac3/ees0pij
3338 ees0mij1=fac3/ees0mij
3339 fac3p=-3.0D0*fac3*rrmij
3340 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3341 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3343 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3344 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3345 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3346 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3347 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3348 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3349 ecosap=ecosa1+ecosa2
3350 ecosbp=ecosb1+ecosb2
3351 ecosgp=ecosg1+ecosg2
3352 ecosam=ecosa1-ecosa2
3353 ecosbm=ecosb1-ecosb2
3354 ecosgm=ecosg1-ecosg2
3363 facont_hb(num_conti,i)=fcont
3366 fprimcont=fprimcont/rij
3367 cd facont_hb(num_conti,i)=1.0D0
3368 C Following line is for diagnostics.
3371 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3372 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3375 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3376 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3378 gggp(1)=gggp(1)+ees0pijp*xj
3379 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3380 gggp(2)=gggp(2)+ees0pijp*yj
3381 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3382 gggp(3)=gggp(3)+ees0pijp*zj
3383 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3384 gggm(1)=gggm(1)+ees0mijp*xj
3385 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3386 gggm(2)=gggm(2)+ees0mijp*yj
3387 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3388 gggm(3)=gggm(3)+ees0mijp*zj
3389 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3390 C Derivatives due to the contact function
3391 gacont_hbr(1,num_conti,i)=fprimcont*xj
3392 gacont_hbr(2,num_conti,i)=fprimcont*yj
3393 gacont_hbr(3,num_conti,i)=fprimcont*zj
3396 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3397 c following the change of gradient-summation algorithm.
3399 cgrad ghalfp=0.5D0*gggp(k)
3400 cgrad ghalfm=0.5D0*gggm(k)
3401 gacontp_hb1(k,num_conti,i)=!ghalfp
3402 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3403 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3404 & *fac_shield(i)*fac_shield(j)*sss
3406 gacontp_hb2(k,num_conti,i)=!ghalfp
3407 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3408 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3409 & *fac_shield(i)*fac_shield(j)*sss
3411 gacontp_hb3(k,num_conti,i)=gggp(k)
3412 & *fac_shield(i)*fac_shield(j)*sss
3414 gacontm_hb1(k,num_conti,i)=!ghalfm
3415 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3416 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3417 & *fac_shield(i)*fac_shield(j)*sss
3419 gacontm_hb2(k,num_conti,i)=!ghalfm
3420 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3421 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3422 & *fac_shield(i)*fac_shield(j)*sss
3424 gacontm_hb3(k,num_conti,i)=gggm(k)
3425 & *fac_shield(i)*fac_shield(j)
3428 C Diagnostics. Comment out or remove after debugging!
3430 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3431 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3432 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3433 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3434 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3435 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3441 endif ! num_conti.le.maxconts
3446 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3449 ghalf=0.5d0*agg(l,k)
3450 aggi(l,k)=aggi(l,k)+ghalf
3451 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3452 aggj(l,k)=aggj(l,k)+ghalf
3455 if (j.eq.nres-1 .and. i.lt.j-2) then
3458 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3464 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3467 C-----------------------------------------------------------------------------
3468 subroutine eturn3(i,eello_turn3)
3469 C Third- and fourth-order contributions from turns
3470 implicit real*8 (a-h,o-z)
3471 include 'DIMENSIONS'
3472 include 'COMMON.IOUNITS'
3473 include 'COMMON.GEO'
3474 include 'COMMON.VAR'
3475 include 'COMMON.LOCAL'
3476 include 'COMMON.CHAIN'
3477 include 'COMMON.DERIV'
3478 include 'COMMON.INTERACT'
3479 include 'COMMON.CONTACTS'
3480 include 'COMMON.TORSION'
3481 include 'COMMON.VECTORS'
3482 include 'COMMON.FFIELD'
3483 include 'COMMON.CONTROL'
3484 include 'COMMON.SHIELD'
3486 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3487 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3488 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3489 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3490 & auxgmat2(2,2),auxgmatt2(2,2)
3491 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3492 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3493 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3494 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3497 c write (iout,*) "eturn3",i,j,j1,j2
3502 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3504 C Third-order contributions
3511 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3512 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3513 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3514 c auxalary matices for theta gradient
3515 c auxalary matrix for i+1 and constant i+2
3516 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3517 c auxalary matrix for i+2 and constant i+1
3518 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3519 call transpose2(auxmat(1,1),auxmat1(1,1))
3520 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3521 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3522 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3523 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3524 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3525 if (shield_mode.eq.0) then
3532 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3533 & *fac_shield(i)*fac_shield(j)
3534 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3535 & *fac_shield(i)*fac_shield(j)
3536 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3540 C Derivatives in theta
3541 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3542 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3543 & *fac_shield(i)*fac_shield(j)
3544 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3545 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3546 & *fac_shield(i)*fac_shield(j)
3549 C Derivatives in shield mode
3550 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3551 & (shield_mode.gt.0)) then
3554 do ilist=1,ishield_list(i)
3555 iresshield=shield_list(ilist,i)
3557 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3559 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3561 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3562 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3566 do ilist=1,ishield_list(j)
3567 iresshield=shield_list(ilist,j)
3569 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3571 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3573 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3574 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3581 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3582 & grad_shield(k,i)*eello_t3/fac_shield(i)
3583 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3584 & grad_shield(k,j)*eello_t3/fac_shield(j)
3585 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3586 & grad_shield(k,i)*eello_t3/fac_shield(i)
3587 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3588 & grad_shield(k,j)*eello_t3/fac_shield(j)
3592 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3593 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3594 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3595 cd & ' eello_turn3_num',4*eello_turn3_num
3596 C Derivatives in gamma(i)
3597 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3598 call transpose2(auxmat2(1,1),auxmat3(1,1))
3599 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3600 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3601 & *fac_shield(i)*fac_shield(j)
3602 C Derivatives in gamma(i+1)
3603 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3604 call transpose2(auxmat2(1,1),auxmat3(1,1))
3605 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3606 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3607 & +0.5d0*(pizda(1,1)+pizda(2,2))
3608 & *fac_shield(i)*fac_shield(j)
3609 C Cartesian derivatives
3611 c ghalf1=0.5d0*agg(l,1)
3612 c ghalf2=0.5d0*agg(l,2)
3613 c ghalf3=0.5d0*agg(l,3)
3614 c ghalf4=0.5d0*agg(l,4)
3615 a_temp(1,1)=aggi(l,1)!+ghalf1
3616 a_temp(1,2)=aggi(l,2)!+ghalf2
3617 a_temp(2,1)=aggi(l,3)!+ghalf3
3618 a_temp(2,2)=aggi(l,4)!+ghalf4
3619 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3620 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3621 & +0.5d0*(pizda(1,1)+pizda(2,2))
3622 & *fac_shield(i)*fac_shield(j)
3624 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3625 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3626 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3627 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3628 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3629 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3630 & +0.5d0*(pizda(1,1)+pizda(2,2))
3631 & *fac_shield(i)*fac_shield(j)
3632 a_temp(1,1)=aggj(l,1)!+ghalf1
3633 a_temp(1,2)=aggj(l,2)!+ghalf2
3634 a_temp(2,1)=aggj(l,3)!+ghalf3
3635 a_temp(2,2)=aggj(l,4)!+ghalf4
3636 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3637 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3638 & +0.5d0*(pizda(1,1)+pizda(2,2))
3639 & *fac_shield(i)*fac_shield(j)
3640 a_temp(1,1)=aggj1(l,1)
3641 a_temp(1,2)=aggj1(l,2)
3642 a_temp(2,1)=aggj1(l,3)
3643 a_temp(2,2)=aggj1(l,4)
3644 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3645 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3646 & +0.5d0*(pizda(1,1)+pizda(2,2))
3647 & *fac_shield(i)*fac_shield(j)
3654 C-------------------------------------------------------------------------------
3655 subroutine eturn4(i,eello_turn4)
3656 C Third- and fourth-order contributions from turns
3657 implicit real*8 (a-h,o-z)
3658 include 'DIMENSIONS'
3659 include 'COMMON.IOUNITS'
3660 include 'COMMON.GEO'
3661 include 'COMMON.VAR'
3662 include 'COMMON.LOCAL'
3663 include 'COMMON.CHAIN'
3664 include 'COMMON.DERIV'
3665 include 'COMMON.INTERACT'
3666 include 'COMMON.CONTACTS'
3667 include 'COMMON.TORSION'
3668 include 'COMMON.VECTORS'
3669 include 'COMMON.FFIELD'
3670 include 'COMMON.CONTROL'
3671 include 'COMMON.SHIELD'
3673 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3674 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3675 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3676 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3677 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3678 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3679 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3680 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3681 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3682 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3683 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3686 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3688 C Fourth-order contributions
3696 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3697 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3698 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3699 c write(iout,*)"WCHODZE W PROGRAM"
3704 iti1=itype2loc(itype(i+1))
3705 iti2=itype2loc(itype(i+2))
3706 iti3=itype2loc(itype(i+3))
3707 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3708 call transpose2(EUg(1,1,i+1),e1t(1,1))
3709 call transpose2(Eug(1,1,i+2),e2t(1,1))
3710 call transpose2(Eug(1,1,i+3),e3t(1,1))
3711 C Ematrix derivative in theta
3712 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3713 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3714 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3715 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3716 c eta1 in derivative theta
3717 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3718 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3719 c auxgvec is derivative of Ub2 so i+3 theta
3720 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3721 c auxalary matrix of E i+1
3722 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3725 s1=scalar2(b1(1,i+2),auxvec(1))
3726 c derivative of theta i+2 with constant i+3
3727 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3728 c derivative of theta i+2 with constant i+2
3729 gs32=scalar2(b1(1,i+2),auxgvec(1))
3730 c derivative of E matix in theta of i+1
3731 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3733 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3734 c ea31 in derivative theta
3735 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3736 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3737 c auxilary matrix auxgvec of Ub2 with constant E matirx
3738 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3739 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3740 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3744 s2=scalar2(b1(1,i+1),auxvec(1))
3745 c derivative of theta i+1 with constant i+3
3746 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3747 c derivative of theta i+2 with constant i+1
3748 gs21=scalar2(b1(1,i+1),auxgvec(1))
3749 c derivative of theta i+3 with constant i+1
3750 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3751 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3753 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3754 c two derivatives over diffetent matrices
3755 c gtae3e2 is derivative over i+3
3756 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3757 c ae3gte2 is derivative over i+2
3758 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3759 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3760 c three possible derivative over theta E matices
3762 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3764 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3766 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3767 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3769 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3770 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3771 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3772 if (shield_mode.eq.0) then
3779 eello_turn4=eello_turn4-(s1+s2+s3)
3780 & *fac_shield(i)*fac_shield(j)
3781 eello_t4=-(s1+s2+s3)
3782 & *fac_shield(i)*fac_shield(j)
3783 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3784 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3785 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3786 C Now derivative over shield:
3787 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3788 & (shield_mode.gt.0)) then
3791 do ilist=1,ishield_list(i)
3792 iresshield=shield_list(ilist,i)
3794 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3796 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3798 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3799 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3803 do ilist=1,ishield_list(j)
3804 iresshield=shield_list(ilist,j)
3806 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3808 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3810 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3811 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3818 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3819 & grad_shield(k,i)*eello_t4/fac_shield(i)
3820 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3821 & grad_shield(k,j)*eello_t4/fac_shield(j)
3822 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3823 & grad_shield(k,i)*eello_t4/fac_shield(i)
3824 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3825 & grad_shield(k,j)*eello_t4/fac_shield(j)
3828 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3829 cd & ' eello_turn4_num',8*eello_turn4_num
3831 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3832 & -(gs13+gsE13+gsEE1)*wturn4
3833 & *fac_shield(i)*fac_shield(j)
3834 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3835 & -(gs23+gs21+gsEE2)*wturn4
3836 & *fac_shield(i)*fac_shield(j)
3838 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3839 & -(gs32+gsE31+gsEE3)*wturn4
3840 & *fac_shield(i)*fac_shield(j)
3842 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3845 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3846 & 'eturn4',i,j,-(s1+s2+s3)
3847 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3848 c & ' eello_turn4_num',8*eello_turn4_num
3849 C Derivatives in gamma(i)
3850 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3851 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3852 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3853 s1=scalar2(b1(1,i+2),auxvec(1))
3854 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3855 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3856 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3857 & *fac_shield(i)*fac_shield(j)
3858 C Derivatives in gamma(i+1)
3859 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3860 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3861 s2=scalar2(b1(1,i+1),auxvec(1))
3862 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3863 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3864 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3865 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3866 & *fac_shield(i)*fac_shield(j)
3867 C Derivatives in gamma(i+2)
3868 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3869 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3870 s1=scalar2(b1(1,i+2),auxvec(1))
3871 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3872 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3873 s2=scalar2(b1(1,i+1),auxvec(1))
3874 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3875 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3876 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3877 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3878 & *fac_shield(i)*fac_shield(j)
3880 C Cartesian derivatives
3881 C Derivatives of this turn contributions in DC(i+2)
3882 if (j.lt.nres-1) then
3884 a_temp(1,1)=agg(l,1)
3885 a_temp(1,2)=agg(l,2)
3886 a_temp(2,1)=agg(l,3)
3887 a_temp(2,2)=agg(l,4)
3888 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3889 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3890 s1=scalar2(b1(1,i+2),auxvec(1))
3891 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3892 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3893 s2=scalar2(b1(1,i+1),auxvec(1))
3894 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3895 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3896 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3898 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3899 & *fac_shield(i)*fac_shield(j)
3902 C Remaining derivatives of this turn contribution
3904 a_temp(1,1)=aggi(l,1)
3905 a_temp(1,2)=aggi(l,2)
3906 a_temp(2,1)=aggi(l,3)
3907 a_temp(2,2)=aggi(l,4)
3908 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3909 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3910 s1=scalar2(b1(1,i+2),auxvec(1))
3911 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3912 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3913 s2=scalar2(b1(1,i+1),auxvec(1))
3914 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3915 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3916 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3917 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3918 & *fac_shield(i)*fac_shield(j)
3919 a_temp(1,1)=aggi1(l,1)
3920 a_temp(1,2)=aggi1(l,2)
3921 a_temp(2,1)=aggi1(l,3)
3922 a_temp(2,2)=aggi1(l,4)
3923 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3924 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3925 s1=scalar2(b1(1,i+2),auxvec(1))
3926 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3927 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3928 s2=scalar2(b1(1,i+1),auxvec(1))
3929 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3930 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3931 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3932 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3933 & *fac_shield(i)*fac_shield(j)
3934 a_temp(1,1)=aggj(l,1)
3935 a_temp(1,2)=aggj(l,2)
3936 a_temp(2,1)=aggj(l,3)
3937 a_temp(2,2)=aggj(l,4)
3938 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3939 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3940 s1=scalar2(b1(1,i+2),auxvec(1))
3941 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3942 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3943 s2=scalar2(b1(1,i+1),auxvec(1))
3944 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3945 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3946 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3947 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3948 & *fac_shield(i)*fac_shield(j)
3949 a_temp(1,1)=aggj1(l,1)
3950 a_temp(1,2)=aggj1(l,2)
3951 a_temp(2,1)=aggj1(l,3)
3952 a_temp(2,2)=aggj1(l,4)
3953 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3954 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3955 s1=scalar2(b1(1,i+2),auxvec(1))
3956 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3957 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3958 s2=scalar2(b1(1,i+1),auxvec(1))
3959 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3960 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3961 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3962 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3963 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3964 & *fac_shield(i)*fac_shield(j)
3971 C-----------------------------------------------------------------------------
3972 subroutine vecpr(u,v,w)
3973 implicit real*8(a-h,o-z)
3974 dimension u(3),v(3),w(3)
3975 w(1)=u(2)*v(3)-u(3)*v(2)
3976 w(2)=-u(1)*v(3)+u(3)*v(1)
3977 w(3)=u(1)*v(2)-u(2)*v(1)
3980 C-----------------------------------------------------------------------------
3981 subroutine unormderiv(u,ugrad,unorm,ungrad)
3982 C This subroutine computes the derivatives of a normalized vector u, given
3983 C the derivatives computed without normalization conditions, ugrad. Returns
3986 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3987 double precision vec(3)
3988 double precision scalar
3990 c write (2,*) 'ugrad',ugrad
3993 vec(i)=scalar(ugrad(1,i),u(1))
3995 c write (2,*) 'vec',vec
3998 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4001 c write (2,*) 'ungrad',ungrad
4004 C-----------------------------------------------------------------------------
4005 subroutine escp(evdw2,evdw2_14)
4007 C This subroutine calculates the excluded-volume interaction energy between
4008 C peptide-group centers and side chains and its gradient in virtual-bond and
4009 C side-chain vectors.
4011 implicit real*8 (a-h,o-z)
4012 include 'DIMENSIONS'
4013 include 'COMMON.GEO'
4014 include 'COMMON.VAR'
4015 include 'COMMON.LOCAL'
4016 include 'COMMON.CHAIN'
4017 include 'COMMON.DERIV'
4018 include 'COMMON.INTERACT'
4019 include 'COMMON.FFIELD'
4020 include 'COMMON.IOUNITS'
4024 cd print '(a)','Enter ESCP'
4025 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4026 c & ' scal14',scal14
4027 do i=iatscp_s,iatscp_e
4028 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4030 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4031 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4032 if (iteli.eq.0) goto 1225
4033 xi=0.5D0*(c(1,i)+c(1,i+1))
4034 yi=0.5D0*(c(2,i)+c(2,i+1))
4035 zi=0.5D0*(c(3,i)+c(3,i+1))
4036 C Returning the ith atom to box
4038 if (xi.lt.0) xi=xi+boxxsize
4040 if (yi.lt.0) yi=yi+boxysize
4042 if (zi.lt.0) zi=zi+boxzsize
4043 do iint=1,nscp_gr(i)
4045 do j=iscpstart(i,iint),iscpend(i,iint)
4046 itypj=iabs(itype(j))
4047 if (itypj.eq.ntyp1) cycle
4048 C Uncomment following three lines for SC-p interactions
4052 C Uncomment following three lines for Ca-p interactions
4056 C returning the jth atom to box
4058 if (xj.lt.0) xj=xj+boxxsize
4060 if (yj.lt.0) yj=yj+boxysize
4062 if (zj.lt.0) zj=zj+boxzsize
4063 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4068 C Finding the closest jth atom
4072 xj=xj_safe+xshift*boxxsize
4073 yj=yj_safe+yshift*boxysize
4074 zj=zj_safe+zshift*boxzsize
4075 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4076 if(dist_temp.lt.dist_init) then
4086 if (subchap.eq.1) then
4095 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4096 C sss is scaling function for smoothing the cutoff gradient otherwise
4097 C the gradient would not be continuouse
4098 sss=sscale(1.0d0/(dsqrt(rrij)))
4099 if (sss.le.0.0d0) cycle
4100 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4102 e1=fac*fac*aad(itypj,iteli)
4103 e2=fac*bad(itypj,iteli)
4104 if (iabs(j-i) .le. 2) then
4107 evdw2_14=evdw2_14+(e1+e2)*sss
4110 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4111 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4112 c & bad(itypj,iteli)
4113 evdw2=evdw2+evdwij*sss
4116 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4118 fac=-(evdwij+e1)*rrij*sss
4119 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4124 cd write (iout,*) 'j<i'
4125 C Uncomment following three lines for SC-p interactions
4127 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4130 cd write (iout,*) 'j>i'
4133 C Uncomment following line for SC-p interactions
4134 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4138 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4142 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4143 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4146 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4156 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4157 gradx_scp(j,i)=expon*gradx_scp(j,i)
4160 C******************************************************************************
4164 C To save time the factor EXPON has been extracted from ALL components
4165 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4168 C******************************************************************************
4171 C--------------------------------------------------------------------------
4172 subroutine edis(ehpb)
4174 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4176 implicit real*8 (a-h,o-z)
4177 include 'DIMENSIONS'
4178 include 'COMMON.SBRIDGE'
4179 include 'COMMON.CHAIN'
4180 include 'COMMON.DERIV'
4181 include 'COMMON.VAR'
4182 include 'COMMON.INTERACT'
4183 include 'COMMON.CONTROL'
4184 include 'COMMON.IOUNITS'
4185 dimension ggg(3),ggg_peak(3,1000)
4188 c 8/21/18 AL: added explicit restraints on reference coords
4189 c write (iout,*) "restr_on_coord",restr_on_coord
4190 if (restr_on_coord) then
4194 if (itype(i).eq.ntyp1) cycle
4196 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4197 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4199 if (itype(i).ne.10) then
4201 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4202 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4205 if (energy_dec) write (iout,*)
4206 & "i",i," bfac",bfac(i)," ecoor",ecoor
4207 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4211 C write (iout,*) ,"link_end",link_end,constr_dist
4212 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4213 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4214 c & " constr_dist",constr_dist
4215 if (link_end.eq.0.and.link_end_peak.eq.0) return
4216 do i=link_start_peak,link_end_peak
4218 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4219 c & ipeak(1,i),ipeak(2,i)
4220 do ip=ipeak(1,i),ipeak(2,i)
4225 C iii and jjj point to the residues for which the distance is assigned.
4226 c if (ii.gt.nres) then
4233 if (ii.gt.nres) then
4238 if (jj.gt.nres) then
4243 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4244 aux=dexp(-scal_peak*aux)
4245 ehpb_peak=ehpb_peak+aux
4246 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4247 & forcon_peak(ip))*aux/dd
4249 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4251 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4252 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4253 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4255 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4256 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4257 do ip=ipeak(1,i),ipeak(2,i)
4260 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4264 C iii and jjj point to the residues for which the distance is assigned.
4265 c if (ii.gt.nres) then
4272 if (ii.gt.nres) then
4277 if (jj.gt.nres) then
4284 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4289 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4293 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4294 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4298 do i=link_start,link_end
4299 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4300 C CA-CA distance used in regularization of structure.
4303 C iii and jjj point to the residues for which the distance is assigned.
4304 c if (ii.gt.nres) then
4311 if (ii.gt.nres) then
4316 if (jj.gt.nres) then
4321 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4322 c & dhpb(i),dhpb1(i),forcon(i)
4323 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4324 C distance and angle dependent SS bond potential.
4325 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4326 C & iabs(itype(jjj)).eq.1) then
4327 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4328 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4329 if (.not.dyn_ss .and. i.le.nss) then
4330 C 15/02/13 CC dynamic SSbond - additional check
4331 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4332 & iabs(itype(jjj)).eq.1) then
4333 call ssbond_ene(iii,jjj,eij)
4336 cd write (iout,*) "eij",eij
4337 cd & ' waga=',waga,' fac=',fac
4338 ! else if (ii.gt.nres .and. jj.gt.nres) then
4340 C Calculate the distance between the two points and its difference from the
4343 if (irestr_type(i).eq.11) then
4344 ehpb=ehpb+fordepth(i)!**4.0d0
4345 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4346 fac=fordepth(i)!**4.0d0
4347 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4348 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4349 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4350 & ehpb,irestr_type(i)
4351 else if (irestr_type(i).eq.10) then
4352 c AL 6//19/2018 cross-link restraints
4353 xdis = 0.5d0*(dd/forcon(i))**2
4354 expdis = dexp(-xdis)
4355 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4356 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4357 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4358 c & " wboltzd",wboltzd
4359 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4360 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4361 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4362 & *expdis/(aux*forcon(i)**2)
4363 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4364 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4365 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4366 else if (irestr_type(i).eq.2) then
4367 c Quartic restraints
4368 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4369 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4370 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4371 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4372 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4374 c Quadratic restraints
4376 C Get the force constant corresponding to this distance.
4378 C Calculate the contribution to energy.
4379 ehpb=ehpb+0.5d0*waga*rdis*rdis
4380 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4381 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4382 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4384 C Evaluate gradient.
4388 c Calculate Cartesian gradient
4390 ggg(j)=fac*(c(j,jj)-c(j,ii))
4392 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4393 C If this is a SC-SC distance, we need to calculate the contributions to the
4394 C Cartesian gradient in the SC vectors (ghpbx).
4397 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4402 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4406 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4407 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4413 C--------------------------------------------------------------------------
4414 subroutine ssbond_ene(i,j,eij)
4416 C Calculate the distance and angle dependent SS-bond potential energy
4417 C using a free-energy function derived based on RHF/6-31G** ab initio
4418 C calculations of diethyl disulfide.
4420 C A. Liwo and U. Kozlowska, 11/24/03
4422 implicit real*8 (a-h,o-z)
4423 include 'DIMENSIONS'
4424 include 'COMMON.SBRIDGE'
4425 include 'COMMON.CHAIN'
4426 include 'COMMON.DERIV'
4427 include 'COMMON.LOCAL'
4428 include 'COMMON.INTERACT'
4429 include 'COMMON.VAR'
4430 include 'COMMON.IOUNITS'
4431 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4432 itypi=iabs(itype(i))
4436 dxi=dc_norm(1,nres+i)
4437 dyi=dc_norm(2,nres+i)
4438 dzi=dc_norm(3,nres+i)
4439 dsci_inv=dsc_inv(itypi)
4440 itypj=iabs(itype(j))
4441 dscj_inv=dsc_inv(itypj)
4445 dxj=dc_norm(1,nres+j)
4446 dyj=dc_norm(2,nres+j)
4447 dzj=dc_norm(3,nres+j)
4448 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4453 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4454 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4455 om12=dxi*dxj+dyi*dyj+dzi*dzj
4457 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4458 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4464 deltat12=om2-om1+2.0d0
4466 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4467 & +akct*deltad*deltat12
4468 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4469 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4470 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4471 c & " deltat12",deltat12," eij",eij
4472 ed=2*akcm*deltad+akct*deltat12
4474 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4475 eom1=-2*akth*deltat1-pom1-om2*pom2
4476 eom2= 2*akth*deltat2+pom1-om1*pom2
4479 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4482 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4483 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4484 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4485 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4488 C Calculate the components of the gradient in DC and X
4492 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4497 C--------------------------------------------------------------------------
4498 subroutine ebond(estr)
4500 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4502 implicit real*8 (a-h,o-z)
4503 include 'DIMENSIONS'
4504 include 'COMMON.LOCAL'
4505 include 'COMMON.GEO'
4506 include 'COMMON.INTERACT'
4507 include 'COMMON.DERIV'
4508 include 'COMMON.VAR'
4509 include 'COMMON.CHAIN'
4510 include 'COMMON.IOUNITS'
4511 include 'COMMON.NAMES'
4512 include 'COMMON.FFIELD'
4513 include 'COMMON.CONTROL'
4514 double precision u(3),ud(3)
4517 c write (iout,*) "distchainmax",distchainmax
4519 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4520 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4522 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4523 C & *dc(j,i-1)/vbld(i)
4525 C if (energy_dec) write(iout,*)
4526 C & "estr1",i,vbld(i),distchainmax,
4527 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4529 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4530 diff = vbld(i)-vbldpDUM
4531 C write(iout,*) i,diff
4533 diff = vbld(i)-vbldp0
4534 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4538 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4541 C write (iout,'(a7,i5,4f7.3)')
4542 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4544 estr=0.5d0*AKP*estr+estr1
4546 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4550 if (iti.ne.10 .and. iti.ne.ntyp1) then
4553 diff=vbld(i+nres)-vbldsc0(1,iti)
4554 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4555 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4556 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4558 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4562 diff=vbld(i+nres)-vbldsc0(j,iti)
4563 ud(j)=aksc(j,iti)*diff
4564 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4578 uprod2=uprod2*u(k)*u(k)
4582 usumsqder=usumsqder+ud(j)*uprod2
4584 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4585 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4586 estr=estr+uprod/usum
4588 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4596 C--------------------------------------------------------------------------
4597 subroutine ebend(etheta,ethetacnstr)
4599 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4600 C angles gamma and its derivatives in consecutive thetas and gammas.
4602 implicit real*8 (a-h,o-z)
4603 include 'DIMENSIONS'
4604 include 'COMMON.LOCAL'
4605 include 'COMMON.GEO'
4606 include 'COMMON.INTERACT'
4607 include 'COMMON.DERIV'
4608 include 'COMMON.VAR'
4609 include 'COMMON.CHAIN'
4610 include 'COMMON.IOUNITS'
4611 include 'COMMON.NAMES'
4612 include 'COMMON.FFIELD'
4613 include 'COMMON.TORCNSTR'
4614 common /calcthet/ term1,term2,termm,diffak,ratak,
4615 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4616 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4617 double precision y(2),z(2)
4619 c time11=dexp(-2*time)
4622 c write (iout,*) "nres",nres
4623 c write (*,'(a,i2)') 'EBEND ICG=',icg
4624 c write (iout,*) ithet_start,ithet_end
4625 do i=ithet_start,ithet_end
4626 C if (itype(i-1).eq.ntyp1) cycle
4628 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4629 & .or.itype(i).eq.ntyp1) cycle
4630 C Zero the energy function and its derivative at 0 or pi.
4631 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4633 ichir1=isign(1,itype(i-2))
4634 ichir2=isign(1,itype(i))
4635 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4636 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4637 if (itype(i-1).eq.10) then
4638 itype1=isign(10,itype(i-2))
4639 ichir11=isign(1,itype(i-2))
4640 ichir12=isign(1,itype(i-2))
4641 itype2=isign(10,itype(i))
4642 ichir21=isign(1,itype(i))
4643 ichir22=isign(1,itype(i))
4650 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4654 c call proc_proc(phii,icrc)
4655 if (icrc.eq.1) phii=150.0
4666 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4670 c call proc_proc(phii1,icrc)
4671 if (icrc.eq.1) phii1=150.0
4683 C Calculate the "mean" value of theta from the part of the distribution
4684 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4685 C In following comments this theta will be referred to as t_c.
4686 thet_pred_mean=0.0d0
4688 athetk=athet(k,it,ichir1,ichir2)
4689 bthetk=bthet(k,it,ichir1,ichir2)
4691 athetk=athet(k,itype1,ichir11,ichir12)
4692 bthetk=bthet(k,itype2,ichir21,ichir22)
4694 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4696 c write (iout,*) "thet_pred_mean",thet_pred_mean
4697 dthett=thet_pred_mean*ssd
4698 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4699 c write (iout,*) "thet_pred_mean",thet_pred_mean
4700 C Derivatives of the "mean" values in gamma1 and gamma2.
4701 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4702 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4703 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4704 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4706 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4707 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4708 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4709 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4711 if (theta(i).gt.pi-delta) then
4712 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4714 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4715 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4716 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4718 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4720 else if (theta(i).lt.delta) then
4721 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4722 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4723 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4725 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4726 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4729 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4732 etheta=etheta+ethetai
4733 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4734 c & 'ebend',i,ethetai,theta(i),itype(i)
4735 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4736 c & rad2deg*phii,rad2deg*phii1,ethetai
4737 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4738 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4739 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4743 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4744 do i=1,ntheta_constr
4745 itheta=itheta_constr(i)
4746 thetiii=theta(itheta)
4747 difi=pinorm(thetiii-theta_constr0(i))
4748 if (difi.gt.theta_drange(i)) then
4749 difi=difi-theta_drange(i)
4750 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4751 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4752 & +for_thet_constr(i)*difi**3
4753 else if (difi.lt.-drange(i)) then
4755 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4756 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4757 & +for_thet_constr(i)*difi**3
4761 C if (energy_dec) then
4762 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4763 C & i,itheta,rad2deg*thetiii,
4764 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4765 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4766 C & gloc(itheta+nphi-2,icg)
4769 C Ufff.... We've done all this!!!
4772 C---------------------------------------------------------------------------
4773 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4775 implicit real*8 (a-h,o-z)
4776 include 'DIMENSIONS'
4777 include 'COMMON.LOCAL'
4778 include 'COMMON.IOUNITS'
4779 common /calcthet/ term1,term2,termm,diffak,ratak,
4780 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4781 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4782 C Calculate the contributions to both Gaussian lobes.
4783 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4784 C The "polynomial part" of the "standard deviation" of this part of
4788 sig=sig*thet_pred_mean+polthet(j,it)
4790 C Derivative of the "interior part" of the "standard deviation of the"
4791 C gamma-dependent Gaussian lobe in t_c.
4792 sigtc=3*polthet(3,it)
4794 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4797 C Set the parameters of both Gaussian lobes of the distribution.
4798 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4799 fac=sig*sig+sigc0(it)
4802 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4803 sigsqtc=-4.0D0*sigcsq*sigtc
4804 c print *,i,sig,sigtc,sigsqtc
4805 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4806 sigtc=-sigtc/(fac*fac)
4807 C Following variable is sigma(t_c)**(-2)
4808 sigcsq=sigcsq*sigcsq
4810 sig0inv=1.0D0/sig0i**2
4811 delthec=thetai-thet_pred_mean
4812 delthe0=thetai-theta0i
4813 term1=-0.5D0*sigcsq*delthec*delthec
4814 term2=-0.5D0*sig0inv*delthe0*delthe0
4815 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4816 C NaNs in taking the logarithm. We extract the largest exponent which is added
4817 C to the energy (this being the log of the distribution) at the end of energy
4818 C term evaluation for this virtual-bond angle.
4819 if (term1.gt.term2) then
4821 term2=dexp(term2-termm)
4825 term1=dexp(term1-termm)
4828 C The ratio between the gamma-independent and gamma-dependent lobes of
4829 C the distribution is a Gaussian function of thet_pred_mean too.
4830 diffak=gthet(2,it)-thet_pred_mean
4831 ratak=diffak/gthet(3,it)**2
4832 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4833 C Let's differentiate it in thet_pred_mean NOW.
4835 C Now put together the distribution terms to make complete distribution.
4836 termexp=term1+ak*term2
4837 termpre=sigc+ak*sig0i
4838 C Contribution of the bending energy from this theta is just the -log of
4839 C the sum of the contributions from the two lobes and the pre-exponential
4840 C factor. Simple enough, isn't it?
4841 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4842 C NOW the derivatives!!!
4843 C 6/6/97 Take into account the deformation.
4844 E_theta=(delthec*sigcsq*term1
4845 & +ak*delthe0*sig0inv*term2)/termexp
4846 E_tc=((sigtc+aktc*sig0i)/termpre
4847 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4848 & aktc*term2)/termexp)
4851 c-----------------------------------------------------------------------------
4852 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4853 implicit real*8 (a-h,o-z)
4854 include 'DIMENSIONS'
4855 include 'COMMON.LOCAL'
4856 include 'COMMON.IOUNITS'
4857 common /calcthet/ term1,term2,termm,diffak,ratak,
4858 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4859 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4860 delthec=thetai-thet_pred_mean
4861 delthe0=thetai-theta0i
4862 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4863 t3 = thetai-thet_pred_mean
4867 t14 = t12+t6*sigsqtc
4869 t21 = thetai-theta0i
4875 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4876 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4877 & *(-t12*t9-ak*sig0inv*t27)
4881 C--------------------------------------------------------------------------
4882 subroutine ebend(etheta)
4884 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4885 C angles gamma and its derivatives in consecutive thetas and gammas.
4886 C ab initio-derived potentials from
4887 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4889 implicit real*8 (a-h,o-z)
4890 include 'DIMENSIONS'
4891 include 'COMMON.LOCAL'
4892 include 'COMMON.GEO'
4893 include 'COMMON.INTERACT'
4894 include 'COMMON.DERIV'
4895 include 'COMMON.VAR'
4896 include 'COMMON.CHAIN'
4897 include 'COMMON.IOUNITS'
4898 include 'COMMON.NAMES'
4899 include 'COMMON.FFIELD'
4900 include 'COMMON.CONTROL'
4901 include 'COMMON.TORCNSTR'
4902 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4903 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4904 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4905 & sinph1ph2(maxdouble,maxdouble)
4906 logical lprn /.false./, lprn1 /.false./
4908 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4909 do i=ithet_start,ithet_end
4911 C if (itype(i-1).eq.ntyp1) cycle
4913 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4914 & .or.itype(i).eq.ntyp1) cycle
4915 if (iabs(itype(i+1)).eq.20) iblock=2
4916 if (iabs(itype(i+1)).ne.20) iblock=1
4920 theti2=0.5d0*theta(i)
4921 ityp2=ithetyp((itype(i-1)))
4923 coskt(k)=dcos(k*theti2)
4924 sinkt(k)=dsin(k*theti2)
4934 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4937 if (phii.ne.phii) phii=150.0
4941 ityp1=ithetyp((itype(i-2)))
4943 cosph1(k)=dcos(k*phii)
4944 sinph1(k)=dsin(k*phii)
4950 ityp1=ithetyp((itype(i-2)))
4956 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4959 if (phii1.ne.phii1) phii1=150.0
4964 ityp3=ithetyp((itype(i)))
4966 cosph2(k)=dcos(k*phii1)
4967 sinph2(k)=dsin(k*phii1)
4972 ityp3=ithetyp((itype(i)))
4978 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4979 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4981 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4984 ccl=cosph1(l)*cosph2(k-l)
4985 ssl=sinph1(l)*sinph2(k-l)
4986 scl=sinph1(l)*cosph2(k-l)
4987 csl=cosph1(l)*sinph2(k-l)
4988 cosph1ph2(l,k)=ccl-ssl
4989 cosph1ph2(k,l)=ccl+ssl
4990 sinph1ph2(l,k)=scl+csl
4991 sinph1ph2(k,l)=scl-csl
4995 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4996 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4997 write (iout,*) "coskt and sinkt"
4999 write (iout,*) k,coskt(k),sinkt(k)
5003 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5004 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5007 & write (iout,*) "k",k,"
5008 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5009 & " ethetai",ethetai
5012 write (iout,*) "cosph and sinph"
5014 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5016 write (iout,*) "cosph1ph2 and sinph2ph2"
5019 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5020 & sinph1ph2(l,k),sinph1ph2(k,l)
5023 write(iout,*) "ethetai",ethetai
5027 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5028 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5029 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5030 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5031 ethetai=ethetai+sinkt(m)*aux
5032 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5033 dephii=dephii+k*sinkt(m)*(
5034 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5035 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5036 dephii1=dephii1+k*sinkt(m)*(
5037 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5038 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5040 & write (iout,*) "m",m," k",k," bbthet",
5041 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5042 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5043 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5044 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5048 & write(iout,*) "ethetai",ethetai
5052 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5053 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5054 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5055 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5056 ethetai=ethetai+sinkt(m)*aux
5057 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5058 dephii=dephii+l*sinkt(m)*(
5059 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5060 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5061 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5062 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5063 dephii1=dephii1+(k-l)*sinkt(m)*(
5064 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5065 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5066 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5067 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5069 write (iout,*) "m",m," k",k," l",l," ffthet",
5070 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5071 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5072 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5073 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5074 & " ethetai",ethetai
5075 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5076 & cosph1ph2(k,l)*sinkt(m),
5077 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5083 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5084 & i,theta(i)*rad2deg,phii*rad2deg,
5085 & phii1*rad2deg,ethetai
5086 etheta=etheta+ethetai
5087 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5088 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5089 c gloc(nphi+i-2,icg)=wang*dethetai
5090 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5096 c-----------------------------------------------------------------------------
5097 subroutine esc(escloc)
5098 C Calculate the local energy of a side chain and its derivatives in the
5099 C corresponding virtual-bond valence angles THETA and the spherical angles
5101 implicit real*8 (a-h,o-z)
5102 include 'DIMENSIONS'
5103 include 'COMMON.GEO'
5104 include 'COMMON.LOCAL'
5105 include 'COMMON.VAR'
5106 include 'COMMON.INTERACT'
5107 include 'COMMON.DERIV'
5108 include 'COMMON.CHAIN'
5109 include 'COMMON.IOUNITS'
5110 include 'COMMON.NAMES'
5111 include 'COMMON.FFIELD'
5112 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5113 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5114 common /sccalc/ time11,time12,time112,theti,it,nlobit
5117 C write (iout,*) 'ESC'
5118 do i=loc_start,loc_end
5120 if (it.eq.ntyp1) cycle
5121 if (it.eq.10) goto 1
5122 nlobit=nlob(iabs(it))
5123 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5124 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5125 theti=theta(i+1)-pipol
5129 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5131 if (x(2).gt.pi-delta) then
5135 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5137 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5138 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5140 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5141 & ddersc0(1),dersc(1))
5142 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5143 & ddersc0(3),dersc(3))
5145 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5147 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5148 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5149 & dersc0(2),esclocbi,dersc02)
5150 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5152 call splinthet(x(2),0.5d0*delta,ss,ssd)
5157 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5159 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5160 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5162 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5164 c write (iout,*) escloci
5165 else if (x(2).lt.delta) then
5169 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5171 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5172 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5174 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5175 & ddersc0(1),dersc(1))
5176 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5177 & ddersc0(3),dersc(3))
5179 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5181 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5182 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5183 & dersc0(2),esclocbi,dersc02)
5184 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5189 call splinthet(x(2),0.5d0*delta,ss,ssd)
5191 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5193 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5194 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5196 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5197 C write (iout,*) 'i=',i, escloci
5199 call enesc(x,escloci,dersc,ddummy,.false.)
5202 escloc=escloc+escloci
5203 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5204 write (iout,'(a6,i5,0pf7.3)')
5205 & 'escloc',i,escloci
5207 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5209 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5210 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5215 C---------------------------------------------------------------------------
5216 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5217 implicit real*8 (a-h,o-z)
5218 include 'DIMENSIONS'
5219 include 'COMMON.GEO'
5220 include 'COMMON.LOCAL'
5221 include 'COMMON.IOUNITS'
5222 common /sccalc/ time11,time12,time112,theti,it,nlobit
5223 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5224 double precision contr(maxlob,-1:1)
5226 c write (iout,*) 'it=',it,' nlobit=',nlobit
5230 if (mixed) ddersc(j)=0.0d0
5234 C Because of periodicity of the dependence of the SC energy in omega we have
5235 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5236 C To avoid underflows, first compute & store the exponents.
5244 z(k)=x(k)-censc(k,j,it)
5249 Axk=Axk+gaussc(l,k,j,it)*z(l)
5255 expfac=expfac+Ax(k,j,iii)*z(k)
5263 C As in the case of ebend, we want to avoid underflows in exponentiation and
5264 C subsequent NaNs and INFs in energy calculation.
5265 C Find the largest exponent
5269 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5273 cd print *,'it=',it,' emin=',emin
5275 C Compute the contribution to SC energy and derivatives
5279 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5280 cd print *,'j=',j,' expfac=',expfac
5281 escloc_i=escloc_i+expfac
5283 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5287 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5288 & +gaussc(k,2,j,it))*expfac
5295 dersc(1)=dersc(1)/cos(theti)**2
5296 ddersc(1)=ddersc(1)/cos(theti)**2
5299 escloci=-(dlog(escloc_i)-emin)
5301 dersc(j)=dersc(j)/escloc_i
5305 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5310 C------------------------------------------------------------------------------
5311 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5312 implicit real*8 (a-h,o-z)
5313 include 'DIMENSIONS'
5314 include 'COMMON.GEO'
5315 include 'COMMON.LOCAL'
5316 include 'COMMON.IOUNITS'
5317 common /sccalc/ time11,time12,time112,theti,it,nlobit
5318 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5319 double precision contr(maxlob)
5330 z(k)=x(k)-censc(k,j,it)
5336 Axk=Axk+gaussc(l,k,j,it)*z(l)
5342 expfac=expfac+Ax(k,j)*z(k)
5347 C As in the case of ebend, we want to avoid underflows in exponentiation and
5348 C subsequent NaNs and INFs in energy calculation.
5349 C Find the largest exponent
5352 if (emin.gt.contr(j)) emin=contr(j)
5356 C Compute the contribution to SC energy and derivatives
5360 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5361 escloc_i=escloc_i+expfac
5363 dersc(k)=dersc(k)+Ax(k,j)*expfac
5365 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5366 & +gaussc(1,2,j,it))*expfac
5370 dersc(1)=dersc(1)/cos(theti)**2
5371 dersc12=dersc12/cos(theti)**2
5372 escloci=-(dlog(escloc_i)-emin)
5374 dersc(j)=dersc(j)/escloc_i
5376 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5380 c----------------------------------------------------------------------------------
5381 subroutine esc(escloc)
5382 C Calculate the local energy of a side chain and its derivatives in the
5383 C corresponding virtual-bond valence angles THETA and the spherical angles
5384 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5385 C added by Urszula Kozlowska. 07/11/2007
5387 implicit real*8 (a-h,o-z)
5388 include 'DIMENSIONS'
5389 include 'COMMON.GEO'
5390 include 'COMMON.LOCAL'
5391 include 'COMMON.VAR'
5392 include 'COMMON.SCROT'
5393 include 'COMMON.INTERACT'
5394 include 'COMMON.DERIV'
5395 include 'COMMON.CHAIN'
5396 include 'COMMON.IOUNITS'
5397 include 'COMMON.NAMES'
5398 include 'COMMON.FFIELD'
5399 include 'COMMON.CONTROL'
5400 include 'COMMON.VECTORS'
5401 double precision x_prime(3),y_prime(3),z_prime(3)
5402 & , sumene,dsc_i,dp2_i,x(65),
5403 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5404 & de_dxx,de_dyy,de_dzz,de_dt
5405 double precision s1_t,s1_6_t,s2_t,s2_6_t
5407 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5408 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5409 & dt_dCi(3),dt_dCi1(3)
5410 common /sccalc/ time11,time12,time112,theti,it,nlobit
5413 do i=loc_start,loc_end
5414 if (itype(i).eq.ntyp1) cycle
5415 costtab(i+1) =dcos(theta(i+1))
5416 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5417 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5418 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5419 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5420 cosfac=dsqrt(cosfac2)
5421 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5422 sinfac=dsqrt(sinfac2)
5424 if (it.eq.10) goto 1
5426 C Compute the axes of tghe local cartesian coordinates system; store in
5427 c x_prime, y_prime and z_prime
5434 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5435 C & dc_norm(3,i+nres)
5437 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5438 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5441 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5444 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5445 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5446 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5447 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5448 c & " xy",scalar(x_prime(1),y_prime(1)),
5449 c & " xz",scalar(x_prime(1),z_prime(1)),
5450 c & " yy",scalar(y_prime(1),y_prime(1)),
5451 c & " yz",scalar(y_prime(1),z_prime(1)),
5452 c & " zz",scalar(z_prime(1),z_prime(1))
5454 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5455 C to local coordinate system. Store in xx, yy, zz.
5461 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5462 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5463 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5470 C Compute the energy of the ith side cbain
5472 c write (2,*) "xx",xx," yy",yy," zz",zz
5475 x(j) = sc_parmin(j,it)
5478 Cc diagnostics - remove later
5480 yy1 = dsin(alph(2))*dcos(omeg(2))
5481 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5482 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5483 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5485 C," --- ", xx_w,yy_w,zz_w
5488 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5489 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5491 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5492 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5494 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5495 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5496 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5497 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5498 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5500 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5501 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5502 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5503 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5504 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5506 dsc_i = 0.743d0+x(61)
5508 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5509 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5510 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5511 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5512 s1=(1+x(63))/(0.1d0 + dscp1)
5513 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5514 s2=(1+x(65))/(0.1d0 + dscp2)
5515 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5516 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5517 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5518 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5520 c & dscp1,dscp2,sumene
5521 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5522 escloc = escloc + sumene
5523 c write (2,*) "escloc",escloc
5524 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5526 if (.not. calc_grad) goto 1
5529 C This section to check the numerical derivatives of the energy of ith side
5530 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5531 C #define DEBUG in the code to turn it on.
5533 write (2,*) "sumene =",sumene
5537 write (2,*) xx,yy,zz
5538 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5539 de_dxx_num=(sumenep-sumene)/aincr
5541 write (2,*) "xx+ sumene from enesc=",sumenep
5544 write (2,*) xx,yy,zz
5545 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5546 de_dyy_num=(sumenep-sumene)/aincr
5548 write (2,*) "yy+ sumene from enesc=",sumenep
5551 write (2,*) xx,yy,zz
5552 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5553 de_dzz_num=(sumenep-sumene)/aincr
5555 write (2,*) "zz+ sumene from enesc=",sumenep
5556 costsave=cost2tab(i+1)
5557 sintsave=sint2tab(i+1)
5558 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5559 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5560 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5561 de_dt_num=(sumenep-sumene)/aincr
5562 write (2,*) " t+ sumene from enesc=",sumenep
5563 cost2tab(i+1)=costsave
5564 sint2tab(i+1)=sintsave
5565 C End of diagnostics section.
5568 C Compute the gradient of esc
5570 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5571 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5572 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5573 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5574 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5575 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5576 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5577 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5578 pom1=(sumene3*sint2tab(i+1)+sumene1)
5579 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5580 pom2=(sumene4*cost2tab(i+1)+sumene2)
5581 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5582 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5583 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5584 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5586 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5587 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5588 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5590 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5591 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5592 & +(pom1+pom2)*pom_dx
5594 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5597 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5598 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5599 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5601 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5602 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5603 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5604 & +x(59)*zz**2 +x(60)*xx*zz
5605 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5606 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5607 & +(pom1-pom2)*pom_dy
5609 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5612 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5613 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5614 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5615 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5616 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5617 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5618 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5619 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5621 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5624 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5625 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5626 & +pom1*pom_dt1+pom2*pom_dt2
5628 write(2,*), "de_dt = ", de_dt,de_dt_num
5632 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5633 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5634 cosfac2xx=cosfac2*xx
5635 sinfac2yy=sinfac2*yy
5637 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5639 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5641 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5642 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5643 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5644 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5645 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5646 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5647 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5648 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5649 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5650 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5654 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5655 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5656 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5657 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5660 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5661 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5662 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5664 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5665 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5669 dXX_Ctab(k,i)=dXX_Ci(k)
5670 dXX_C1tab(k,i)=dXX_Ci1(k)
5671 dYY_Ctab(k,i)=dYY_Ci(k)
5672 dYY_C1tab(k,i)=dYY_Ci1(k)
5673 dZZ_Ctab(k,i)=dZZ_Ci(k)
5674 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5675 dXX_XYZtab(k,i)=dXX_XYZ(k)
5676 dYY_XYZtab(k,i)=dYY_XYZ(k)
5677 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5681 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5682 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5683 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5684 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5685 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5687 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5688 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5689 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5690 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5691 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5692 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5693 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5694 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5696 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5697 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5699 C to check gradient call subroutine check_grad
5706 c------------------------------------------------------------------------------
5707 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5709 C This procedure calculates two-body contact function g(rij) and its derivative:
5712 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5715 C where x=(rij-r0ij)/delta
5717 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5720 double precision rij,r0ij,eps0ij,fcont,fprimcont
5721 double precision x,x2,x4,delta
5725 if (x.lt.-1.0D0) then
5728 else if (x.le.1.0D0) then
5731 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5732 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5739 c------------------------------------------------------------------------------
5740 subroutine splinthet(theti,delta,ss,ssder)
5741 implicit real*8 (a-h,o-z)
5742 include 'DIMENSIONS'
5743 include 'COMMON.VAR'
5744 include 'COMMON.GEO'
5747 if (theti.gt.pipol) then
5748 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5750 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5755 c------------------------------------------------------------------------------
5756 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5758 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5759 double precision ksi,ksi2,ksi3,a1,a2,a3
5760 a1=fprim0*delta/(f1-f0)
5766 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5767 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5770 c------------------------------------------------------------------------------
5771 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5773 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5774 double precision ksi,ksi2,ksi3,a1,a2,a3
5779 a2=3*(f1x-f0x)-2*fprim0x*delta
5780 a3=fprim0x*delta-2*(f1x-f0x)
5781 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5784 C-----------------------------------------------------------------------------
5786 C-----------------------------------------------------------------------------
5787 subroutine etor(etors,fact)
5788 implicit real*8 (a-h,o-z)
5789 include 'DIMENSIONS'
5790 include 'COMMON.VAR'
5791 include 'COMMON.GEO'
5792 include 'COMMON.LOCAL'
5793 include 'COMMON.TORSION'
5794 include 'COMMON.INTERACT'
5795 include 'COMMON.DERIV'
5796 include 'COMMON.CHAIN'
5797 include 'COMMON.NAMES'
5798 include 'COMMON.IOUNITS'
5799 include 'COMMON.FFIELD'
5800 include 'COMMON.TORCNSTR'
5802 C Set lprn=.true. for debugging
5806 do i=iphi_start,iphi_end
5807 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5808 & .or. itype(i).eq.ntyp1) cycle
5809 itori=itortyp(itype(i-2))
5810 itori1=itortyp(itype(i-1))
5813 C Proline-Proline pair is a special case...
5814 if (itori.eq.3 .and. itori1.eq.3) then
5815 if (phii.gt.-dwapi3) then
5817 fac=1.0D0/(1.0D0-cosphi)
5818 etorsi=v1(1,3,3)*fac
5819 etorsi=etorsi+etorsi
5820 etors=etors+etorsi-v1(1,3,3)
5821 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5824 v1ij=v1(j+1,itori,itori1)
5825 v2ij=v2(j+1,itori,itori1)
5828 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5829 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5833 v1ij=v1(j,itori,itori1)
5834 v2ij=v2(j,itori,itori1)
5837 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5838 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5842 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5843 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5844 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5845 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5846 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5850 c------------------------------------------------------------------------------
5852 subroutine etor(etors,fact)
5853 implicit real*8 (a-h,o-z)
5854 include 'DIMENSIONS'
5855 include 'COMMON.VAR'
5856 include 'COMMON.GEO'
5857 include 'COMMON.LOCAL'
5858 include 'COMMON.TORSION'
5859 include 'COMMON.INTERACT'
5860 include 'COMMON.DERIV'
5861 include 'COMMON.CHAIN'
5862 include 'COMMON.NAMES'
5863 include 'COMMON.IOUNITS'
5864 include 'COMMON.FFIELD'
5865 include 'COMMON.TORCNSTR'
5867 C Set lprn=.true. for debugging
5871 do i=iphi_start,iphi_end
5873 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5874 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5875 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5876 C & .or. itype(i).eq.ntyp1) cycle
5877 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5878 if (iabs(itype(i)).eq.20) then
5883 itori=itortyp(itype(i-2))
5884 itori1=itortyp(itype(i-1))
5887 C Regular cosine and sine terms
5888 do j=1,nterm(itori,itori1,iblock)
5889 v1ij=v1(j,itori,itori1,iblock)
5890 v2ij=v2(j,itori,itori1,iblock)
5893 etors=etors+v1ij*cosphi+v2ij*sinphi
5894 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5898 C E = SUM ----------------------------------- - v1
5899 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5901 cosphi=dcos(0.5d0*phii)
5902 sinphi=dsin(0.5d0*phii)
5903 do j=1,nlor(itori,itori1,iblock)
5904 vl1ij=vlor1(j,itori,itori1)
5905 vl2ij=vlor2(j,itori,itori1)
5906 vl3ij=vlor3(j,itori,itori1)
5907 pom=vl2ij*cosphi+vl3ij*sinphi
5908 pom1=1.0d0/(pom*pom+1.0d0)
5909 etors=etors+vl1ij*pom1
5910 c if (energy_dec) etors_ii=etors_ii+
5913 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5915 C Subtract the constant term
5916 etors=etors-v0(itori,itori1,iblock)
5918 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5919 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5920 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5921 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5922 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5927 c----------------------------------------------------------------------------
5928 subroutine etor_d(etors_d,fact2)
5929 C 6/23/01 Compute double torsional energy
5930 implicit real*8 (a-h,o-z)
5931 include 'DIMENSIONS'
5932 include 'COMMON.VAR'
5933 include 'COMMON.GEO'
5934 include 'COMMON.LOCAL'
5935 include 'COMMON.TORSION'
5936 include 'COMMON.INTERACT'
5937 include 'COMMON.DERIV'
5938 include 'COMMON.CHAIN'
5939 include 'COMMON.NAMES'
5940 include 'COMMON.IOUNITS'
5941 include 'COMMON.FFIELD'
5942 include 'COMMON.TORCNSTR'
5944 C Set lprn=.true. for debugging
5948 do i=iphi_start,iphi_end-1
5950 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5951 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5952 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5953 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5954 & (itype(i+1).eq.ntyp1)) cycle
5955 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5957 itori=itortyp(itype(i-2))
5958 itori1=itortyp(itype(i-1))
5959 itori2=itortyp(itype(i))
5965 if (iabs(itype(i+1)).eq.20) iblock=2
5966 C Regular cosine and sine terms
5967 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5968 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5969 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5970 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5971 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5972 cosphi1=dcos(j*phii)
5973 sinphi1=dsin(j*phii)
5974 cosphi2=dcos(j*phii1)
5975 sinphi2=dsin(j*phii1)
5976 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5977 & v2cij*cosphi2+v2sij*sinphi2
5978 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5979 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5981 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5983 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5984 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5985 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5986 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5987 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5988 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5989 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5990 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5991 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5992 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5993 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5994 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5995 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5996 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5999 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6000 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6006 c---------------------------------------------------------------------------
6007 C The rigorous attempt to derive energy function
6008 subroutine etor_kcc(etors,fact)
6009 implicit real*8 (a-h,o-z)
6010 include 'DIMENSIONS'
6011 include 'COMMON.VAR'
6012 include 'COMMON.GEO'
6013 include 'COMMON.LOCAL'
6014 include 'COMMON.TORSION'
6015 include 'COMMON.INTERACT'
6016 include 'COMMON.DERIV'
6017 include 'COMMON.CHAIN'
6018 include 'COMMON.NAMES'
6019 include 'COMMON.IOUNITS'
6020 include 'COMMON.FFIELD'
6021 include 'COMMON.TORCNSTR'
6022 include 'COMMON.CONTROL'
6023 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
6025 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
6026 C Set lprn=.true. for debugging
6029 C print *,"wchodze kcc"
6030 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
6032 do i=iphi_start,iphi_end
6033 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6034 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6035 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6036 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6037 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6038 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6039 itori=itortyp(itype(i-2))
6040 itori1=itortyp(itype(i-1))
6045 C to avoid multiple devision by 2
6046 c theti22=0.5d0*theta(i)
6047 C theta 12 is the theta_1 /2
6048 C theta 22 is theta_2 /2
6049 c theti12=0.5d0*theta(i-1)
6050 C and appropriate sinus function
6051 sinthet1=dsin(theta(i-1))
6052 sinthet2=dsin(theta(i))
6053 costhet1=dcos(theta(i-1))
6054 costhet2=dcos(theta(i))
6055 C to speed up lets store its mutliplication
6056 sint1t2=sinthet2*sinthet1
6058 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
6059 C +d_n*sin(n*gamma)) *
6060 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
6061 C we have two sum 1) Non-Chebyshev which is with n and gamma
6062 nval=nterm_kcc_Tb(itori,itori1)
6068 c1(j)=c1(j-1)*costhet1
6069 c2(j)=c2(j-1)*costhet2
6072 do j=1,nterm_kcc(itori,itori1)
6076 sint1t2n=sint1t2n*sint1t2
6082 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6083 gradvalct1=gradvalct1+
6084 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6085 gradvalct2=gradvalct2+
6086 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6089 gradvalct1=-gradvalct1*sinthet1
6090 gradvalct2=-gradvalct2*sinthet2
6096 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6097 gradvalst1=gradvalst1+
6098 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6099 gradvalst2=gradvalst2+
6100 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6103 gradvalst1=-gradvalst1*sinthet1
6104 gradvalst2=-gradvalst2*sinthet2
6105 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6106 C glocig is the gradient local i site in gamma
6107 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6108 C now gradient over theta_1
6109 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6110 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6111 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6112 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6115 C derivative over gamma
6116 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6117 C derivative over theta1
6118 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6119 C now derivative over theta2
6120 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6122 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6123 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6127 c---------------------------------------------------------------------------------------------
6128 subroutine etor_constr(edihcnstr)
6129 implicit real*8 (a-h,o-z)
6130 include 'DIMENSIONS'
6131 include 'COMMON.VAR'
6132 include 'COMMON.GEO'
6133 include 'COMMON.LOCAL'
6134 include 'COMMON.TORSION'
6135 include 'COMMON.INTERACT'
6136 include 'COMMON.DERIV'
6137 include 'COMMON.CHAIN'
6138 include 'COMMON.NAMES'
6139 include 'COMMON.IOUNITS'
6140 include 'COMMON.FFIELD'
6141 include 'COMMON.TORCNSTR'
6142 include 'COMMON.CONTROL'
6143 ! 6/20/98 - dihedral angle constraints
6145 c do i=1,ndih_constr
6146 c write (iout,*) "idihconstr_start",idihconstr_start,
6147 c & " idihconstr_end",idihconstr_end
6148 if (raw_psipred) then
6149 do i=idihconstr_start,idihconstr_end
6150 itori=idih_constr(i)
6152 gaudih_i=vpsipred(1,i)
6156 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6157 dexpcos_i=dexp(-cos_i*cos_i)
6158 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6159 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6160 & *cos_i*dexpcos_i/s**2
6162 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6163 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6165 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6166 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6167 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6168 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6169 & -wdihc*dlog(gaudih_i)
6172 do i=idihconstr_start,idihconstr_end
6173 itori=idih_constr(i)
6175 difi=pinorm(phii-phi0(i))
6176 if (difi.gt.drange(i)) then
6178 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6179 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6180 else if (difi.lt.-drange(i)) then
6182 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6183 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6191 c----------------------------------------------------------------------------
6192 C The rigorous attempt to derive energy function
6193 subroutine ebend_kcc(etheta)
6195 implicit real*8 (a-h,o-z)
6196 include 'DIMENSIONS'
6197 include 'COMMON.VAR'
6198 include 'COMMON.GEO'
6199 include 'COMMON.LOCAL'
6200 include 'COMMON.TORSION'
6201 include 'COMMON.INTERACT'
6202 include 'COMMON.DERIV'
6203 include 'COMMON.CHAIN'
6204 include 'COMMON.NAMES'
6205 include 'COMMON.IOUNITS'
6206 include 'COMMON.FFIELD'
6207 include 'COMMON.TORCNSTR'
6208 include 'COMMON.CONTROL'
6210 double precision thybt1(maxang_kcc)
6211 C Set lprn=.true. for debugging
6214 C print *,"wchodze kcc"
6215 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6217 do i=ithet_start,ithet_end
6218 c print *,i,itype(i-1),itype(i),itype(i-2)
6219 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6220 & .or.itype(i).eq.ntyp1) cycle
6221 iti=iabs(itortyp(itype(i-1)))
6222 sinthet=dsin(theta(i))
6223 costhet=dcos(theta(i))
6224 do j=1,nbend_kcc_Tb(iti)
6225 thybt1(j)=v1bend_chyb(j,iti)
6227 sumth1thyb=v1bend_chyb(0,iti)+
6228 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6229 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6231 ihelp=nbend_kcc_Tb(iti)-1
6232 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6233 etheta=etheta+sumth1thyb
6234 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6235 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6239 c-------------------------------------------------------------------------------------
6240 subroutine etheta_constr(ethetacnstr)
6242 implicit real*8 (a-h,o-z)
6243 include 'DIMENSIONS'
6244 include 'COMMON.VAR'
6245 include 'COMMON.GEO'
6246 include 'COMMON.LOCAL'
6247 include 'COMMON.TORSION'
6248 include 'COMMON.INTERACT'
6249 include 'COMMON.DERIV'
6250 include 'COMMON.CHAIN'
6251 include 'COMMON.NAMES'
6252 include 'COMMON.IOUNITS'
6253 include 'COMMON.FFIELD'
6254 include 'COMMON.TORCNSTR'
6255 include 'COMMON.CONTROL'
6257 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6258 do i=ithetaconstr_start,ithetaconstr_end
6259 itheta=itheta_constr(i)
6260 thetiii=theta(itheta)
6261 difi=pinorm(thetiii-theta_constr0(i))
6262 if (difi.gt.theta_drange(i)) then
6263 difi=difi-theta_drange(i)
6264 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6265 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6266 & +for_thet_constr(i)*difi**3
6267 else if (difi.lt.-drange(i)) then
6269 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6270 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6271 & +for_thet_constr(i)*difi**3
6275 if (energy_dec) then
6276 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6277 & i,itheta,rad2deg*thetiii,
6278 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6279 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6280 & gloc(itheta+nphi-2,icg)
6285 c------------------------------------------------------------------------------
6286 c------------------------------------------------------------------------------
6287 subroutine eback_sc_corr(esccor)
6288 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6289 c conformational states; temporarily implemented as differences
6290 c between UNRES torsional potentials (dependent on three types of
6291 c residues) and the torsional potentials dependent on all 20 types
6292 c of residues computed from AM1 energy surfaces of terminally-blocked
6293 c amino-acid residues.
6294 implicit real*8 (a-h,o-z)
6295 include 'DIMENSIONS'
6296 include 'COMMON.VAR'
6297 include 'COMMON.GEO'
6298 include 'COMMON.LOCAL'
6299 include 'COMMON.TORSION'
6300 include 'COMMON.SCCOR'
6301 include 'COMMON.INTERACT'
6302 include 'COMMON.DERIV'
6303 include 'COMMON.CHAIN'
6304 include 'COMMON.NAMES'
6305 include 'COMMON.IOUNITS'
6306 include 'COMMON.FFIELD'
6307 include 'COMMON.CONTROL'
6309 C Set lprn=.true. for debugging
6312 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6314 do i=itau_start,itau_end
6315 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6317 isccori=isccortyp(itype(i-2))
6318 isccori1=isccortyp(itype(i-1))
6320 do intertyp=1,3 !intertyp
6321 cc Added 09 May 2012 (Adasko)
6322 cc Intertyp means interaction type of backbone mainchain correlation:
6323 c 1 = SC...Ca...Ca...Ca
6324 c 2 = Ca...Ca...Ca...SC
6325 c 3 = SC...Ca...Ca...SCi
6327 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6328 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6329 & (itype(i-1).eq.ntyp1)))
6330 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6331 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6332 & .or.(itype(i).eq.ntyp1)))
6333 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6334 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6335 & (itype(i-3).eq.ntyp1)))) cycle
6336 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6337 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6339 do j=1,nterm_sccor(isccori,isccori1)
6340 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6341 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6342 cosphi=dcos(j*tauangle(intertyp,i))
6343 sinphi=dsin(j*tauangle(intertyp,i))
6344 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6345 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6347 C write (iout,*)"EBACK_SC_COR",esccor,i
6348 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6349 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6350 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6352 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6353 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6354 & (v1sccor(j,1,itori,itori1),j=1,6)
6355 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6356 c gsccor_loc(i-3)=gloci
6362 c------------------------------------------------------------------------------
6363 subroutine multibody(ecorr)
6364 C This subroutine calculates multi-body contributions to energy following
6365 C the idea of Skolnick et al. If side chains I and J make a contact and
6366 C at the same time side chains I+1 and J+1 make a contact, an extra
6367 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6368 implicit real*8 (a-h,o-z)
6369 include 'DIMENSIONS'
6370 include 'COMMON.IOUNITS'
6371 include 'COMMON.DERIV'
6372 include 'COMMON.INTERACT'
6373 include 'COMMON.CONTACTS'
6374 include 'COMMON.CONTMAT'
6375 include 'COMMON.CORRMAT'
6376 double precision gx(3),gx1(3)
6379 C Set lprn=.true. for debugging
6383 write (iout,'(a)') 'Contact function values:'
6385 write (iout,'(i2,20(1x,i2,f10.5))')
6386 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6401 num_conti=num_cont(i)
6402 num_conti1=num_cont(i1)
6407 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6408 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6409 cd & ' ishift=',ishift
6410 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6411 C The system gains extra energy.
6412 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6413 endif ! j1==j+-ishift
6422 c------------------------------------------------------------------------------
6423 double precision function esccorr(i,j,k,l,jj,kk)
6424 implicit real*8 (a-h,o-z)
6425 include 'DIMENSIONS'
6426 include 'COMMON.IOUNITS'
6427 include 'COMMON.DERIV'
6428 include 'COMMON.INTERACT'
6429 include 'COMMON.CONTACTS'
6430 include 'COMMON.CONTMAT'
6431 include 'COMMON.CORRMAT'
6432 double precision gx(3),gx1(3)
6437 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6438 C Calculate the multi-body contribution to energy.
6439 C Calculate multi-body contributions to the gradient.
6440 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6441 cd & k,l,(gacont(m,kk,k),m=1,3)
6443 gx(m) =ekl*gacont(m,jj,i)
6444 gx1(m)=eij*gacont(m,kk,k)
6445 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6446 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6447 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6448 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6452 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6457 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6463 c------------------------------------------------------------------------------
6464 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6465 C This subroutine calculates multi-body contributions to hydrogen-bonding
6466 implicit real*8 (a-h,o-z)
6467 include 'DIMENSIONS'
6468 include 'COMMON.IOUNITS'
6469 include 'COMMON.FFIELD'
6470 include 'COMMON.DERIV'
6471 include 'COMMON.INTERACT'
6472 include 'COMMON.CONTACTS'
6473 include 'COMMON.CONTMAT'
6474 include 'COMMON.CORRMAT'
6475 double precision gx(3),gx1(3)
6478 C Set lprn=.true. for debugging
6481 write (iout,'(a)') 'Contact function values:'
6483 write (iout,'(2i3,50(1x,i2,f5.2))')
6484 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6485 & j=1,num_cont_hb(i))
6489 C Remove the loop below after debugging !!!
6496 C Calculate the local-electrostatic correlation terms
6497 do i=iatel_s,iatel_e+1
6499 num_conti=num_cont_hb(i)
6500 num_conti1=num_cont_hb(i+1)
6505 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6506 c & ' jj=',jj,' kk=',kk
6507 if (j1.eq.j+1 .or. j1.eq.j-1) then
6508 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6509 C The system gains extra energy.
6510 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6512 else if (j1.eq.j) then
6513 C Contacts I-J and I-(J+1) occur simultaneously.
6514 C The system loses extra energy.
6515 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6520 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6521 c & ' jj=',jj,' kk=',kk
6523 C Contacts I-J and (I+1)-J occur simultaneously.
6524 C The system loses extra energy.
6525 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6532 c------------------------------------------------------------------------------
6533 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6535 C This subroutine calculates multi-body contributions to hydrogen-bonding
6536 implicit real*8 (a-h,o-z)
6537 include 'DIMENSIONS'
6538 include 'COMMON.IOUNITS'
6542 include 'COMMON.FFIELD'
6543 include 'COMMON.DERIV'
6544 include 'COMMON.LOCAL'
6545 include 'COMMON.INTERACT'
6546 include 'COMMON.CONTACTS'
6547 include 'COMMON.CONTMAT'
6548 include 'COMMON.CORRMAT'
6549 include 'COMMON.CHAIN'
6550 include 'COMMON.CONTROL'
6551 include 'COMMON.SHIELD'
6552 double precision gx(3),gx1(3)
6553 integer num_cont_hb_old(maxres)
6555 double precision eello4,eello5,eelo6,eello_turn6
6556 external eello4,eello5,eello6,eello_turn6
6557 C Set lprn=.true. for debugging
6561 write (iout,'(a)') 'Contact function values:'
6563 write (iout,'(2i3,50(1x,i2,5f6.3))')
6564 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6565 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6571 C Remove the loop below after debugging !!!
6578 C Calculate the dipole-dipole interaction energies
6579 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6580 do i=iatel_s,iatel_e+1
6581 num_conti=num_cont_hb(i)
6590 C Calculate the local-electrostatic correlation terms
6591 c write (iout,*) "gradcorr5 in eello5 before loop"
6593 c write (iout,'(i5,3f10.5)')
6594 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6596 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6597 c write (iout,*) "corr loop i",i
6599 num_conti=num_cont_hb(i)
6600 num_conti1=num_cont_hb(i+1)
6607 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6608 c & ' jj=',jj,' kk=',kk
6609 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6610 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6611 & .or. j.lt.0 .and. j1.gt.0) .and.
6612 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6613 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6614 C The system gains extra energy.
6616 sqd1=dsqrt(d_cont(jj,i))
6617 sqd2=dsqrt(d_cont(kk,i1))
6618 sred_geom = sqd1*sqd2
6619 IF (sred_geom.lt.cutoff_corr) THEN
6620 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6622 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6623 cd & ' jj=',jj,' kk=',kk
6624 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6625 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6627 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6628 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6631 cd write (iout,*) 'sred_geom=',sred_geom,
6632 cd & ' ekont=',ekont,' fprim=',fprimcont,
6633 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6634 cd write (iout,*) "g_contij",g_contij
6635 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6636 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6637 call calc_eello(i,jp,i+1,jp1,jj,kk)
6638 if (wcorr4.gt.0.0d0)
6639 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6640 CC & *fac_shield(i)**2*fac_shield(j)**2
6641 if (energy_dec.and.wcorr4.gt.0.0d0)
6642 1 write (iout,'(a6,4i5,0pf7.3)')
6643 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6644 c write (iout,*) "gradcorr5 before eello5"
6646 c write (iout,'(i5,3f10.5)')
6647 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6649 if (wcorr5.gt.0.0d0)
6650 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6651 c write (iout,*) "gradcorr5 after eello5"
6653 c write (iout,'(i5,3f10.5)')
6654 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6656 if (energy_dec.and.wcorr5.gt.0.0d0)
6657 1 write (iout,'(a6,4i5,0pf7.3)')
6658 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6659 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6660 cd write(2,*)'ijkl',i,jp,i+1,jp1
6661 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6662 & .or. wturn6.eq.0.0d0))then
6663 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6664 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6665 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6666 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6667 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6668 cd & 'ecorr6=',ecorr6
6669 cd write (iout,'(4e15.5)') sred_geom,
6670 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6671 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6672 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6673 else if (wturn6.gt.0.0d0
6674 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6675 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6676 eturn6=eturn6+eello_turn6(i,jj,kk)
6677 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6678 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6679 cd write (2,*) 'multibody_eello:eturn6',eturn6
6688 num_cont_hb(i)=num_cont_hb_old(i)
6690 c write (iout,*) "gradcorr5 in eello5"
6692 c write (iout,'(i5,3f10.5)')
6693 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6697 c------------------------------------------------------------------------------
6698 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6699 implicit real*8 (a-h,o-z)
6700 include 'DIMENSIONS'
6701 include 'COMMON.IOUNITS'
6702 include 'COMMON.DERIV'
6703 include 'COMMON.INTERACT'
6704 include 'COMMON.CONTACTS'
6705 include 'COMMON.CONTMAT'
6706 include 'COMMON.CORRMAT'
6707 include 'COMMON.SHIELD'
6708 include 'COMMON.CONTROL'
6709 double precision gx(3),gx1(3)
6712 C print *,"wchodze",fac_shield(i),shield_mode
6720 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6722 C & fac_shield(i)**2*fac_shield(j)**2
6723 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6724 C Following 4 lines for diagnostics.
6729 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6730 c & 'Contacts ',i,j,
6731 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6732 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6734 C Calculate the multi-body contribution to energy.
6735 C ecorr=ecorr+ekont*ees
6736 C Calculate multi-body contributions to the gradient.
6737 coeffpees0pij=coeffp*ees0pij
6738 coeffmees0mij=coeffm*ees0mij
6739 coeffpees0pkl=coeffp*ees0pkl
6740 coeffmees0mkl=coeffm*ees0mkl
6742 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6743 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6744 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6745 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6746 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6747 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6748 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6749 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6750 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6751 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6752 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6753 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6754 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6755 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6756 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6757 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6758 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6759 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6760 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6761 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6762 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6763 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6764 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6765 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6766 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6771 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6772 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6773 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6774 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6779 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6780 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6781 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6782 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6785 c write (iout,*) "ehbcorr",ekont*ees
6786 C print *,ekont,ees,i,k
6788 C now gradient over shielding
6790 if (shield_mode.gt.0) then
6793 C print *,i,j,fac_shield(i),fac_shield(j),
6794 C &fac_shield(k),fac_shield(l)
6795 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6796 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6797 do ilist=1,ishield_list(i)
6798 iresshield=shield_list(ilist,i)
6800 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6802 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6804 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6805 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6809 do ilist=1,ishield_list(j)
6810 iresshield=shield_list(ilist,j)
6812 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6814 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6816 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6817 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6822 do ilist=1,ishield_list(k)
6823 iresshield=shield_list(ilist,k)
6825 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6827 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6829 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6830 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6834 do ilist=1,ishield_list(l)
6835 iresshield=shield_list(ilist,l)
6837 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6839 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6841 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6842 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6846 C print *,gshieldx(m,iresshield)
6848 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6849 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6850 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6851 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6852 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6853 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6854 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6855 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6857 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6858 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6859 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6860 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6861 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6862 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6863 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6864 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6872 C---------------------------------------------------------------------------
6873 subroutine dipole(i,j,jj)
6874 implicit real*8 (a-h,o-z)
6875 include 'DIMENSIONS'
6876 include 'COMMON.IOUNITS'
6877 include 'COMMON.CHAIN'
6878 include 'COMMON.FFIELD'
6879 include 'COMMON.DERIV'
6880 include 'COMMON.INTERACT'
6881 include 'COMMON.CONTACTS'
6882 include 'COMMON.CONTMAT'
6883 include 'COMMON.CORRMAT'
6884 include 'COMMON.TORSION'
6885 include 'COMMON.VAR'
6886 include 'COMMON.GEO'
6887 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6889 iti1 = itortyp(itype(i+1))
6890 if (j.lt.nres-1) then
6891 itj1 = itype2loc(itype(j+1))
6896 dipi(iii,1)=Ub2(iii,i)
6897 dipderi(iii)=Ub2der(iii,i)
6898 dipi(iii,2)=b1(iii,i+1)
6899 dipj(iii,1)=Ub2(iii,j)
6900 dipderj(iii)=Ub2der(iii,j)
6901 dipj(iii,2)=b1(iii,j+1)
6905 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6908 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6915 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6919 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6924 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6925 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6927 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6929 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6931 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6936 C---------------------------------------------------------------------------
6937 subroutine calc_eello(i,j,k,l,jj,kk)
6939 C This subroutine computes matrices and vectors needed to calculate
6940 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6942 implicit real*8 (a-h,o-z)
6943 include 'DIMENSIONS'
6944 include 'COMMON.IOUNITS'
6945 include 'COMMON.CHAIN'
6946 include 'COMMON.DERIV'
6947 include 'COMMON.INTERACT'
6948 include 'COMMON.CONTACTS'
6949 include 'COMMON.CONTMAT'
6950 include 'COMMON.CORRMAT'
6951 include 'COMMON.TORSION'
6952 include 'COMMON.VAR'
6953 include 'COMMON.GEO'
6954 include 'COMMON.FFIELD'
6955 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6956 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6959 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6960 cd & ' jj=',jj,' kk=',kk
6961 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6962 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6963 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6966 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6967 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6970 call transpose2(aa1(1,1),aa1t(1,1))
6971 call transpose2(aa2(1,1),aa2t(1,1))
6974 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6975 & aa1tder(1,1,lll,kkk))
6976 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6977 & aa2tder(1,1,lll,kkk))
6981 C parallel orientation of the two CA-CA-CA frames.
6983 iti=itype2loc(itype(i))
6987 itk1=itype2loc(itype(k+1))
6988 itj=itype2loc(itype(j))
6989 if (l.lt.nres-1) then
6990 itl1=itype2loc(itype(l+1))
6994 C A1 kernel(j+1) A2T
6996 cd write (iout,'(3f10.5,5x,3f10.5)')
6997 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6999 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7000 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7001 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7002 C Following matrices are needed only for 6-th order cumulants
7003 IF (wcorr6.gt.0.0d0) THEN
7004 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7005 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7006 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7007 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7008 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7009 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7010 & ADtEAderx(1,1,1,1,1,1))
7012 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7013 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7014 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7015 & ADtEA1derx(1,1,1,1,1,1))
7017 C End 6-th order cumulants
7020 cd write (2,*) 'In calc_eello6'
7022 cd write (2,*) 'iii=',iii
7024 cd write (2,*) 'kkk=',kkk
7026 cd write (2,'(3(2f10.5),5x)')
7027 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7032 call transpose2(EUgder(1,1,k),auxmat(1,1))
7033 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7034 call transpose2(EUg(1,1,k),auxmat(1,1))
7035 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7036 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7040 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7041 & EAEAderx(1,1,lll,kkk,iii,1))
7045 C A1T kernel(i+1) A2
7046 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7047 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7048 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7049 C Following matrices are needed only for 6-th order cumulants
7050 IF (wcorr6.gt.0.0d0) THEN
7051 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7052 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7053 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7054 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7055 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7056 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7057 & ADtEAderx(1,1,1,1,1,2))
7058 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7059 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7060 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7061 & ADtEA1derx(1,1,1,1,1,2))
7063 C End 6-th order cumulants
7064 call transpose2(EUgder(1,1,l),auxmat(1,1))
7065 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7066 call transpose2(EUg(1,1,l),auxmat(1,1))
7067 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7068 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7072 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7073 & EAEAderx(1,1,lll,kkk,iii,2))
7078 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7079 C They are needed only when the fifth- or the sixth-order cumulants are
7081 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7082 call transpose2(AEA(1,1,1),auxmat(1,1))
7083 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7084 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7085 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7086 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7087 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7088 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7089 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7090 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7091 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7092 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7093 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7094 call transpose2(AEA(1,1,2),auxmat(1,1))
7095 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7096 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7097 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7098 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7099 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7100 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7101 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7102 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7103 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7104 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7105 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7106 C Calculate the Cartesian derivatives of the vectors.
7110 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7111 call matvec2(auxmat(1,1),b1(1,i),
7112 & AEAb1derx(1,lll,kkk,iii,1,1))
7113 call matvec2(auxmat(1,1),Ub2(1,i),
7114 & AEAb2derx(1,lll,kkk,iii,1,1))
7115 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7116 & AEAb1derx(1,lll,kkk,iii,2,1))
7117 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7118 & AEAb2derx(1,lll,kkk,iii,2,1))
7119 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7120 call matvec2(auxmat(1,1),b1(1,j),
7121 & AEAb1derx(1,lll,kkk,iii,1,2))
7122 call matvec2(auxmat(1,1),Ub2(1,j),
7123 & AEAb2derx(1,lll,kkk,iii,1,2))
7124 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7125 & AEAb1derx(1,lll,kkk,iii,2,2))
7126 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7127 & AEAb2derx(1,lll,kkk,iii,2,2))
7134 C Antiparallel orientation of the two CA-CA-CA frames.
7136 iti=itype2loc(itype(i))
7140 itk1=itype2loc(itype(k+1))
7141 itl=itype2loc(itype(l))
7142 itj=itype2loc(itype(j))
7143 if (j.lt.nres-1) then
7144 itj1=itype2loc(itype(j+1))
7148 C A2 kernel(j-1)T A1T
7149 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7150 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7151 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7152 C Following matrices are needed only for 6-th order cumulants
7153 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7154 & j.eq.i+4 .and. l.eq.i+3)) THEN
7155 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7156 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7157 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7158 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7159 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7160 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7161 & ADtEAderx(1,1,1,1,1,1))
7162 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7163 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7164 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7165 & ADtEA1derx(1,1,1,1,1,1))
7167 C End 6-th order cumulants
7168 call transpose2(EUgder(1,1,k),auxmat(1,1))
7169 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7170 call transpose2(EUg(1,1,k),auxmat(1,1))
7171 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7172 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7176 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7177 & EAEAderx(1,1,lll,kkk,iii,1))
7181 C A2T kernel(i+1)T A1
7182 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7183 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7184 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7185 C Following matrices are needed only for 6-th order cumulants
7186 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7187 & j.eq.i+4 .and. l.eq.i+3)) THEN
7188 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7189 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7190 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7191 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7192 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7193 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7194 & ADtEAderx(1,1,1,1,1,2))
7195 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7196 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7197 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7198 & ADtEA1derx(1,1,1,1,1,2))
7200 C End 6-th order cumulants
7201 call transpose2(EUgder(1,1,j),auxmat(1,1))
7202 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7203 call transpose2(EUg(1,1,j),auxmat(1,1))
7204 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7205 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7209 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7210 & EAEAderx(1,1,lll,kkk,iii,2))
7215 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7216 C They are needed only when the fifth- or the sixth-order cumulants are
7218 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7219 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7220 call transpose2(AEA(1,1,1),auxmat(1,1))
7221 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7222 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7223 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7224 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7225 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7226 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7227 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7228 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7229 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7230 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7231 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7232 call transpose2(AEA(1,1,2),auxmat(1,1))
7233 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7234 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7235 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7236 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7237 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7238 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7239 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7240 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7241 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7242 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7243 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7244 C Calculate the Cartesian derivatives of the vectors.
7248 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7249 call matvec2(auxmat(1,1),b1(1,i),
7250 & AEAb1derx(1,lll,kkk,iii,1,1))
7251 call matvec2(auxmat(1,1),Ub2(1,i),
7252 & AEAb2derx(1,lll,kkk,iii,1,1))
7253 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7254 & AEAb1derx(1,lll,kkk,iii,2,1))
7255 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7256 & AEAb2derx(1,lll,kkk,iii,2,1))
7257 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7258 call matvec2(auxmat(1,1),b1(1,l),
7259 & AEAb1derx(1,lll,kkk,iii,1,2))
7260 call matvec2(auxmat(1,1),Ub2(1,l),
7261 & AEAb2derx(1,lll,kkk,iii,1,2))
7262 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7263 & AEAb1derx(1,lll,kkk,iii,2,2))
7264 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7265 & AEAb2derx(1,lll,kkk,iii,2,2))
7274 C---------------------------------------------------------------------------
7275 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7276 & KK,KKderg,AKA,AKAderg,AKAderx)
7280 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7281 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7282 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7287 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7289 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7292 cd if (lprn) write (2,*) 'In kernel'
7294 cd if (lprn) write (2,*) 'kkk=',kkk
7296 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7297 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7299 cd write (2,*) 'lll=',lll
7300 cd write (2,*) 'iii=1'
7302 cd write (2,'(3(2f10.5),5x)')
7303 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7306 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7307 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7309 cd write (2,*) 'lll=',lll
7310 cd write (2,*) 'iii=2'
7312 cd write (2,'(3(2f10.5),5x)')
7313 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7320 C---------------------------------------------------------------------------
7321 double precision function eello4(i,j,k,l,jj,kk)
7322 implicit real*8 (a-h,o-z)
7323 include 'DIMENSIONS'
7324 include 'COMMON.IOUNITS'
7325 include 'COMMON.CHAIN'
7326 include 'COMMON.DERIV'
7327 include 'COMMON.INTERACT'
7328 include 'COMMON.CONTACTS'
7329 include 'COMMON.CONTMAT'
7330 include 'COMMON.CORRMAT'
7331 include 'COMMON.TORSION'
7332 include 'COMMON.VAR'
7333 include 'COMMON.GEO'
7334 double precision pizda(2,2),ggg1(3),ggg2(3)
7335 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7339 cd print *,'eello4:',i,j,k,l,jj,kk
7340 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7341 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7342 cold eij=facont_hb(jj,i)
7343 cold ekl=facont_hb(kk,k)
7345 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7347 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7348 gcorr_loc(k-1)=gcorr_loc(k-1)
7349 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7351 gcorr_loc(l-1)=gcorr_loc(l-1)
7352 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7354 gcorr_loc(j-1)=gcorr_loc(j-1)
7355 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7360 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7361 & -EAEAderx(2,2,lll,kkk,iii,1)
7362 cd derx(lll,kkk,iii)=0.0d0
7366 cd gcorr_loc(l-1)=0.0d0
7367 cd gcorr_loc(j-1)=0.0d0
7368 cd gcorr_loc(k-1)=0.0d0
7370 cd write (iout,*)'Contacts have occurred for peptide groups',
7371 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7372 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7373 if (j.lt.nres-1) then
7380 if (l.lt.nres-1) then
7388 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7389 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7390 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7391 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7392 cgrad ghalf=0.5d0*ggg1(ll)
7393 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7394 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7395 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7396 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7397 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7398 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7399 cgrad ghalf=0.5d0*ggg2(ll)
7400 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7401 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7402 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7403 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7404 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7405 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7409 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7414 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7419 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7424 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7428 cd write (2,*) iii,gcorr_loc(iii)
7432 cd write (2,*) 'ekont',ekont
7433 cd write (iout,*) 'eello4',ekont*eel4
7436 C---------------------------------------------------------------------------
7437 double precision function eello5(i,j,k,l,jj,kk)
7438 implicit real*8 (a-h,o-z)
7439 include 'DIMENSIONS'
7440 include 'COMMON.IOUNITS'
7441 include 'COMMON.CHAIN'
7442 include 'COMMON.DERIV'
7443 include 'COMMON.INTERACT'
7444 include 'COMMON.CONTACTS'
7445 include 'COMMON.CONTMAT'
7446 include 'COMMON.CORRMAT'
7447 include 'COMMON.TORSION'
7448 include 'COMMON.VAR'
7449 include 'COMMON.GEO'
7450 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7451 double precision ggg1(3),ggg2(3)
7452 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7457 C /l\ / \ \ / \ / \ / C
7458 C / \ / \ \ / \ / \ / C
7459 C j| o |l1 | o | o| o | | o |o C
7460 C \ |/k\| |/ \| / |/ \| |/ \| C
7461 C \i/ \ / \ / / \ / \ C
7463 C (I) (II) (III) (IV) C
7465 C eello5_1 eello5_2 eello5_3 eello5_4 C
7467 C Antiparallel chains C
7470 C /j\ / \ \ / \ / \ / C
7471 C / \ / \ \ / \ / \ / C
7472 C j1| o |l | o | o| o | | o |o C
7473 C \ |/k\| |/ \| / |/ \| |/ \| C
7474 C \i/ \ / \ / / \ / \ C
7476 C (I) (II) (III) (IV) C
7478 C eello5_1 eello5_2 eello5_3 eello5_4 C
7480 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7482 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7483 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7488 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7490 itk=itype2loc(itype(k))
7491 itl=itype2loc(itype(l))
7492 itj=itype2loc(itype(j))
7497 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7498 cd & eel5_3_num,eel5_4_num)
7502 derx(lll,kkk,iii)=0.0d0
7506 cd eij=facont_hb(jj,i)
7507 cd ekl=facont_hb(kk,k)
7509 cd write (iout,*)'Contacts have occurred for peptide groups',
7510 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7512 C Contribution from the graph I.
7513 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7514 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7515 call transpose2(EUg(1,1,k),auxmat(1,1))
7516 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7517 vv(1)=pizda(1,1)-pizda(2,2)
7518 vv(2)=pizda(1,2)+pizda(2,1)
7519 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7520 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7522 C Explicit gradient in virtual-dihedral angles.
7523 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7524 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7525 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7526 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7527 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7528 vv(1)=pizda(1,1)-pizda(2,2)
7529 vv(2)=pizda(1,2)+pizda(2,1)
7530 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7531 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7532 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7533 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7534 vv(1)=pizda(1,1)-pizda(2,2)
7535 vv(2)=pizda(1,2)+pizda(2,1)
7537 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7538 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7539 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7541 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7542 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7543 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7545 C Cartesian gradient
7549 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7551 vv(1)=pizda(1,1)-pizda(2,2)
7552 vv(2)=pizda(1,2)+pizda(2,1)
7553 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7554 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7555 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7562 C Contribution from graph II
7563 call transpose2(EE(1,1,k),auxmat(1,1))
7564 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7565 vv(1)=pizda(1,1)+pizda(2,2)
7566 vv(2)=pizda(2,1)-pizda(1,2)
7567 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7568 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7570 C Explicit gradient in virtual-dihedral angles.
7571 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7572 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7573 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7574 vv(1)=pizda(1,1)+pizda(2,2)
7575 vv(2)=pizda(2,1)-pizda(1,2)
7577 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7578 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7579 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7581 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7582 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7583 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7585 C Cartesian gradient
7589 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7591 vv(1)=pizda(1,1)+pizda(2,2)
7592 vv(2)=pizda(2,1)-pizda(1,2)
7593 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7594 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7595 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7604 C Parallel orientation
7605 C Contribution from graph III
7606 call transpose2(EUg(1,1,l),auxmat(1,1))
7607 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7608 vv(1)=pizda(1,1)-pizda(2,2)
7609 vv(2)=pizda(1,2)+pizda(2,1)
7610 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7611 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7613 C Explicit gradient in virtual-dihedral angles.
7614 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7615 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7616 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7617 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7618 vv(1)=pizda(1,1)-pizda(2,2)
7619 vv(2)=pizda(1,2)+pizda(2,1)
7620 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7621 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7622 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7623 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7624 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7625 vv(1)=pizda(1,1)-pizda(2,2)
7626 vv(2)=pizda(1,2)+pizda(2,1)
7627 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7628 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7629 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7630 C Cartesian gradient
7634 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7636 vv(1)=pizda(1,1)-pizda(2,2)
7637 vv(2)=pizda(1,2)+pizda(2,1)
7638 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7639 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7640 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7645 C Contribution from graph IV
7647 call transpose2(EE(1,1,l),auxmat(1,1))
7648 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7649 vv(1)=pizda(1,1)+pizda(2,2)
7650 vv(2)=pizda(2,1)-pizda(1,2)
7651 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7652 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7653 C Explicit gradient in virtual-dihedral angles.
7654 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7655 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7656 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7657 vv(1)=pizda(1,1)+pizda(2,2)
7658 vv(2)=pizda(2,1)-pizda(1,2)
7659 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7660 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7661 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7662 C Cartesian gradient
7666 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7668 vv(1)=pizda(1,1)+pizda(2,2)
7669 vv(2)=pizda(2,1)-pizda(1,2)
7670 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7671 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7672 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7678 C Antiparallel orientation
7679 C Contribution from graph III
7681 call transpose2(EUg(1,1,j),auxmat(1,1))
7682 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7683 vv(1)=pizda(1,1)-pizda(2,2)
7684 vv(2)=pizda(1,2)+pizda(2,1)
7685 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7686 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7688 C Explicit gradient in virtual-dihedral angles.
7689 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7690 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7691 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7692 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7693 vv(1)=pizda(1,1)-pizda(2,2)
7694 vv(2)=pizda(1,2)+pizda(2,1)
7695 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7696 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7697 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7698 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7699 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7700 vv(1)=pizda(1,1)-pizda(2,2)
7701 vv(2)=pizda(1,2)+pizda(2,1)
7702 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7703 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7704 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7705 C Cartesian gradient
7709 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7711 vv(1)=pizda(1,1)-pizda(2,2)
7712 vv(2)=pizda(1,2)+pizda(2,1)
7713 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7714 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7715 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7721 C Contribution from graph IV
7723 call transpose2(EE(1,1,j),auxmat(1,1))
7724 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7725 vv(1)=pizda(1,1)+pizda(2,2)
7726 vv(2)=pizda(2,1)-pizda(1,2)
7727 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7728 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7730 C Explicit gradient in virtual-dihedral angles.
7731 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7732 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7733 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7734 vv(1)=pizda(1,1)+pizda(2,2)
7735 vv(2)=pizda(2,1)-pizda(1,2)
7736 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7737 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7738 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7739 C Cartesian gradient
7743 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7745 vv(1)=pizda(1,1)+pizda(2,2)
7746 vv(2)=pizda(2,1)-pizda(1,2)
7747 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7748 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7749 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7756 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7757 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7758 cd write (2,*) 'ijkl',i,j,k,l
7759 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7760 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7762 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7763 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7764 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7765 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7767 if (j.lt.nres-1) then
7774 if (l.lt.nres-1) then
7784 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7785 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7786 C summed up outside the subrouine as for the other subroutines
7787 C handling long-range interactions. The old code is commented out
7788 C with "cgrad" to keep track of changes.
7790 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7791 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7792 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7793 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7794 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7795 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7796 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7797 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7798 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7799 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7801 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7802 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7803 cgrad ghalf=0.5d0*ggg1(ll)
7805 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7806 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7807 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7808 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7809 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7810 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7811 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7812 cgrad ghalf=0.5d0*ggg2(ll)
7814 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7815 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7816 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7817 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7818 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7819 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7825 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7826 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7831 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7832 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7838 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7843 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7847 cd write (2,*) iii,g_corr5_loc(iii)
7850 cd write (2,*) 'ekont',ekont
7851 cd write (iout,*) 'eello5',ekont*eel5
7854 c--------------------------------------------------------------------------
7855 double precision function eello6(i,j,k,l,jj,kk)
7856 implicit real*8 (a-h,o-z)
7857 include 'DIMENSIONS'
7858 include 'COMMON.IOUNITS'
7859 include 'COMMON.CHAIN'
7860 include 'COMMON.DERIV'
7861 include 'COMMON.INTERACT'
7862 include 'COMMON.CONTACTS'
7863 include 'COMMON.CONTMAT'
7864 include 'COMMON.CORRMAT'
7865 include 'COMMON.TORSION'
7866 include 'COMMON.VAR'
7867 include 'COMMON.GEO'
7868 include 'COMMON.FFIELD'
7869 double precision ggg1(3),ggg2(3)
7870 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7875 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7883 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7884 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7888 derx(lll,kkk,iii)=0.0d0
7892 cd eij=facont_hb(jj,i)
7893 cd ekl=facont_hb(kk,k)
7899 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7900 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7901 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7902 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7903 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7904 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7906 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7907 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7908 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7909 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7910 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7911 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7915 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7917 C If turn contributions are considered, they will be handled separately.
7918 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7919 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7920 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7921 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7922 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7923 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7924 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7927 if (j.lt.nres-1) then
7934 if (l.lt.nres-1) then
7942 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7943 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7944 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7945 cgrad ghalf=0.5d0*ggg1(ll)
7947 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7948 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7949 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7950 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7951 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7952 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7953 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7954 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7955 cgrad ghalf=0.5d0*ggg2(ll)
7956 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7958 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7959 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7960 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7961 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7962 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7963 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7969 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7970 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7975 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7976 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7982 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7987 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7991 cd write (2,*) iii,g_corr6_loc(iii)
7994 cd write (2,*) 'ekont',ekont
7995 cd write (iout,*) 'eello6',ekont*eel6
7998 c--------------------------------------------------------------------------
7999 double precision function eello6_graph1(i,j,k,l,imat,swap)
8000 implicit real*8 (a-h,o-z)
8001 include 'DIMENSIONS'
8002 include 'COMMON.IOUNITS'
8003 include 'COMMON.CHAIN'
8004 include 'COMMON.DERIV'
8005 include 'COMMON.INTERACT'
8006 include 'COMMON.CONTACTS'
8007 include 'COMMON.CONTMAT'
8008 include 'COMMON.CORRMAT'
8009 include 'COMMON.TORSION'
8010 include 'COMMON.VAR'
8011 include 'COMMON.GEO'
8012 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8016 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8018 C Parallel Antiparallel C
8024 C \ j|/k\| / \ |/k\|l / C
8029 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8030 itk=itype2loc(itype(k))
8031 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8032 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8033 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8034 call transpose2(EUgC(1,1,k),auxmat(1,1))
8035 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8036 vv1(1)=pizda1(1,1)-pizda1(2,2)
8037 vv1(2)=pizda1(1,2)+pizda1(2,1)
8038 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8039 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8040 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8041 s5=scalar2(vv(1),Dtobr2(1,i))
8042 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8043 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8045 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8046 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8047 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8048 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8049 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8050 & +scalar2(vv(1),Dtobr2der(1,i)))
8051 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8052 vv1(1)=pizda1(1,1)-pizda1(2,2)
8053 vv1(2)=pizda1(1,2)+pizda1(2,1)
8054 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8055 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8057 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8058 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8059 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8060 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8061 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8063 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8064 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8065 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8066 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8067 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8069 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8070 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8071 vv1(1)=pizda1(1,1)-pizda1(2,2)
8072 vv1(2)=pizda1(1,2)+pizda1(2,1)
8073 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8074 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8075 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8076 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8085 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8086 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8087 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8088 call transpose2(EUgC(1,1,k),auxmat(1,1))
8089 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8091 vv1(1)=pizda1(1,1)-pizda1(2,2)
8092 vv1(2)=pizda1(1,2)+pizda1(2,1)
8093 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8094 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8095 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8096 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8097 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8098 s5=scalar2(vv(1),Dtobr2(1,i))
8099 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8106 c----------------------------------------------------------------------------
8107 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8108 implicit real*8 (a-h,o-z)
8109 include 'DIMENSIONS'
8110 include 'COMMON.IOUNITS'
8111 include 'COMMON.CHAIN'
8112 include 'COMMON.DERIV'
8113 include 'COMMON.INTERACT'
8114 include 'COMMON.CONTACTS'
8115 include 'COMMON.CONTMAT'
8116 include 'COMMON.CORRMAT'
8117 include 'COMMON.TORSION'
8118 include 'COMMON.VAR'
8119 include 'COMMON.GEO'
8121 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8122 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8125 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8127 C Parallel Antiparallel C
8133 C \ j|/k\| \ |/k\|l C
8138 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8139 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8140 C AL 7/4/01 s1 would occur in the sixth-order moment,
8141 C but not in a cluster cumulant
8143 s1=dip(1,jj,i)*dip(1,kk,k)
8145 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8146 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8147 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8148 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8149 call transpose2(EUg(1,1,k),auxmat(1,1))
8150 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8151 vv(1)=pizda(1,1)-pizda(2,2)
8152 vv(2)=pizda(1,2)+pizda(2,1)
8153 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8154 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8156 eello6_graph2=-(s1+s2+s3+s4)
8158 eello6_graph2=-(s2+s3+s4)
8161 C Derivatives in gamma(i-1)
8165 s1=dipderg(1,jj,i)*dip(1,kk,k)
8167 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8168 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8169 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8170 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8172 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8174 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8176 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8178 C Derivatives in gamma(k-1)
8180 s1=dip(1,jj,i)*dipderg(1,kk,k)
8182 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8183 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8184 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8185 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8186 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8187 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8188 vv(1)=pizda(1,1)-pizda(2,2)
8189 vv(2)=pizda(1,2)+pizda(2,1)
8190 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8192 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8194 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8196 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8197 C Derivatives in gamma(j-1) or gamma(l-1)
8200 s1=dipderg(3,jj,i)*dip(1,kk,k)
8202 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8203 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8204 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8205 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8206 vv(1)=pizda(1,1)-pizda(2,2)
8207 vv(2)=pizda(1,2)+pizda(2,1)
8208 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8211 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8213 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8216 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8217 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8219 C Derivatives in gamma(l-1) or gamma(j-1)
8222 s1=dip(1,jj,i)*dipderg(3,kk,k)
8224 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8225 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8226 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8227 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8228 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8229 vv(1)=pizda(1,1)-pizda(2,2)
8230 vv(2)=pizda(1,2)+pizda(2,1)
8231 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8234 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8236 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8239 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8240 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8242 C Cartesian derivatives.
8244 write (2,*) 'In eello6_graph2'
8246 write (2,*) 'iii=',iii
8248 write (2,*) 'kkk=',kkk
8250 write (2,'(3(2f10.5),5x)')
8251 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8261 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8263 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8266 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8268 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8269 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8271 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8272 call transpose2(EUg(1,1,k),auxmat(1,1))
8273 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8275 vv(1)=pizda(1,1)-pizda(2,2)
8276 vv(2)=pizda(1,2)+pizda(2,1)
8277 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8278 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8280 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8282 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8285 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8287 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8295 c----------------------------------------------------------------------------
8296 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8297 implicit real*8 (a-h,o-z)
8298 include 'DIMENSIONS'
8299 include 'COMMON.IOUNITS'
8300 include 'COMMON.CHAIN'
8301 include 'COMMON.DERIV'
8302 include 'COMMON.INTERACT'
8303 include 'COMMON.CONTACTS'
8304 include 'COMMON.CONTMAT'
8305 include 'COMMON.CORRMAT'
8306 include 'COMMON.TORSION'
8307 include 'COMMON.VAR'
8308 include 'COMMON.GEO'
8309 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8311 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8313 C Parallel Antiparallel C
8319 C j|/k\| / |/k\|l / C
8324 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8326 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8327 C energy moment and not to the cluster cumulant.
8328 iti=itortyp(itype(i))
8329 if (j.lt.nres-1) then
8330 itj1=itype2loc(itype(j+1))
8334 itk=itype2loc(itype(k))
8335 itk1=itype2loc(itype(k+1))
8336 if (l.lt.nres-1) then
8337 itl1=itype2loc(itype(l+1))
8342 s1=dip(4,jj,i)*dip(4,kk,k)
8344 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8345 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8346 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8347 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8348 call transpose2(EE(1,1,k),auxmat(1,1))
8349 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8350 vv(1)=pizda(1,1)+pizda(2,2)
8351 vv(2)=pizda(2,1)-pizda(1,2)
8352 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8353 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8354 cd & "sum",-(s2+s3+s4)
8356 eello6_graph3=-(s1+s2+s3+s4)
8358 eello6_graph3=-(s2+s3+s4)
8361 C Derivatives in gamma(k-1)
8363 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8364 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8365 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8366 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8367 C Derivatives in gamma(l-1)
8368 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8369 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8370 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8371 vv(1)=pizda(1,1)+pizda(2,2)
8372 vv(2)=pizda(2,1)-pizda(1,2)
8373 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8374 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8375 C Cartesian derivatives.
8381 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8383 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8386 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8388 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8389 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8391 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8392 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8394 vv(1)=pizda(1,1)+pizda(2,2)
8395 vv(2)=pizda(2,1)-pizda(1,2)
8396 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8398 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8400 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8403 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8405 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8407 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8414 c----------------------------------------------------------------------------
8415 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8416 implicit real*8 (a-h,o-z)
8417 include 'DIMENSIONS'
8418 include 'COMMON.IOUNITS'
8419 include 'COMMON.CHAIN'
8420 include 'COMMON.DERIV'
8421 include 'COMMON.INTERACT'
8422 include 'COMMON.CONTACTS'
8423 include 'COMMON.CONTMAT'
8424 include 'COMMON.CORRMAT'
8425 include 'COMMON.TORSION'
8426 include 'COMMON.VAR'
8427 include 'COMMON.GEO'
8428 include 'COMMON.FFIELD'
8429 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8430 & auxvec1(2),auxmat1(2,2)
8432 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8434 C Parallel Antiparallel C
8440 C \ j|/k\| \ |/k\|l C
8445 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8447 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8448 C energy moment and not to the cluster cumulant.
8449 cd write (2,*) 'eello_graph4: wturn6',wturn6
8450 iti=itype2loc(itype(i))
8451 itj=itype2loc(itype(j))
8452 if (j.lt.nres-1) then
8453 itj1=itype2loc(itype(j+1))
8457 itk=itype2loc(itype(k))
8458 if (k.lt.nres-1) then
8459 itk1=itype2loc(itype(k+1))
8463 itl=itype2loc(itype(l))
8464 if (l.lt.nres-1) then
8465 itl1=itype2loc(itype(l+1))
8469 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8470 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8471 cd & ' itl',itl,' itl1',itl1
8474 s1=dip(3,jj,i)*dip(3,kk,k)
8476 s1=dip(2,jj,j)*dip(2,kk,l)
8479 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8480 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8482 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8483 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8485 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8486 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8488 call transpose2(EUg(1,1,k),auxmat(1,1))
8489 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8490 vv(1)=pizda(1,1)-pizda(2,2)
8491 vv(2)=pizda(2,1)+pizda(1,2)
8492 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8493 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8495 eello6_graph4=-(s1+s2+s3+s4)
8497 eello6_graph4=-(s2+s3+s4)
8499 C Derivatives in gamma(i-1)
8504 s1=dipderg(2,jj,i)*dip(3,kk,k)
8506 s1=dipderg(4,jj,j)*dip(2,kk,l)
8509 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8511 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8512 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8514 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8515 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8517 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8518 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8519 cd write (2,*) 'turn6 derivatives'
8521 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8523 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8527 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8529 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8533 C Derivatives in gamma(k-1)
8536 s1=dip(3,jj,i)*dipderg(2,kk,k)
8538 s1=dip(2,jj,j)*dipderg(4,kk,l)
8541 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8542 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8544 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8545 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8547 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8548 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8550 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8551 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8552 vv(1)=pizda(1,1)-pizda(2,2)
8553 vv(2)=pizda(2,1)+pizda(1,2)
8554 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8555 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8557 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8559 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8563 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8565 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8568 C Derivatives in gamma(j-1) or gamma(l-1)
8569 if (l.eq.j+1 .and. l.gt.1) then
8570 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8571 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8572 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8573 vv(1)=pizda(1,1)-pizda(2,2)
8574 vv(2)=pizda(2,1)+pizda(1,2)
8575 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8576 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8577 else if (j.gt.1) then
8578 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8579 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8580 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8581 vv(1)=pizda(1,1)-pizda(2,2)
8582 vv(2)=pizda(2,1)+pizda(1,2)
8583 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8584 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8585 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8587 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8590 C Cartesian derivatives.
8597 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8599 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8603 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8605 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8609 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8611 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8613 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8614 & b1(1,j+1),auxvec(1))
8615 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8617 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8618 & b1(1,l+1),auxvec(1))
8619 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8621 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8623 vv(1)=pizda(1,1)-pizda(2,2)
8624 vv(2)=pizda(2,1)+pizda(1,2)
8625 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8627 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8629 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8632 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8635 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8638 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8642 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8646 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8648 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8651 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8653 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8662 c----------------------------------------------------------------------------
8663 double precision function eello_turn6(i,jj,kk)
8664 implicit real*8 (a-h,o-z)
8665 include 'DIMENSIONS'
8666 include 'COMMON.IOUNITS'
8667 include 'COMMON.CHAIN'
8668 include 'COMMON.DERIV'
8669 include 'COMMON.INTERACT'
8670 include 'COMMON.CONTACTS'
8671 include 'COMMON.CONTMAT'
8672 include 'COMMON.CORRMAT'
8673 include 'COMMON.TORSION'
8674 include 'COMMON.VAR'
8675 include 'COMMON.GEO'
8676 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8677 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8679 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8680 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8681 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8682 C the respective energy moment and not to the cluster cumulant.
8691 iti=itype2loc(itype(i))
8692 itk=itype2loc(itype(k))
8693 itk1=itype2loc(itype(k+1))
8694 itl=itype2loc(itype(l))
8695 itj=itype2loc(itype(j))
8696 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8697 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8698 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8703 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8705 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8709 derx_turn(lll,kkk,iii)=0.0d0
8716 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8718 cd write (2,*) 'eello6_5',eello6_5
8720 call transpose2(AEA(1,1,1),auxmat(1,1))
8721 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8722 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8723 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8725 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8726 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8727 s2 = scalar2(b1(1,k),vtemp1(1))
8729 call transpose2(AEA(1,1,2),atemp(1,1))
8730 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8731 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8732 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8734 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8735 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8736 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8738 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8739 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8740 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8741 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8742 ss13 = scalar2(b1(1,k),vtemp4(1))
8743 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8745 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8751 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8752 C Derivatives in gamma(i+2)
8757 call transpose2(AEA(1,1,1),auxmatd(1,1))
8758 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8759 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8760 call transpose2(AEAderg(1,1,2),atempd(1,1))
8761 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8762 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8764 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8765 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8766 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8772 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8773 C Derivatives in gamma(i+3)
8775 call transpose2(AEA(1,1,1),auxmatd(1,1))
8776 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8777 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8778 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8780 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8781 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8782 s2d = scalar2(b1(1,k),vtemp1d(1))
8784 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8785 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8787 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8789 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8790 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8791 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8799 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8800 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8802 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8803 & -0.5d0*ekont*(s2d+s12d)
8805 C Derivatives in gamma(i+4)
8806 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8807 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8808 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8810 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8811 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8812 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8820 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8822 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8824 C Derivatives in gamma(i+5)
8826 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8827 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8828 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8830 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8831 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8832 s2d = scalar2(b1(1,k),vtemp1d(1))
8834 call transpose2(AEA(1,1,2),atempd(1,1))
8835 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8836 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8838 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8839 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8841 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8842 ss13d = scalar2(b1(1,k),vtemp4d(1))
8843 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8851 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8852 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8854 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8855 & -0.5d0*ekont*(s2d+s12d)
8857 C Cartesian derivatives
8862 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8863 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8864 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8866 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8867 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8869 s2d = scalar2(b1(1,k),vtemp1d(1))
8871 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8872 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8873 s8d = -(atempd(1,1)+atempd(2,2))*
8874 & scalar2(cc(1,1,l),vtemp2(1))
8876 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8878 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8879 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8886 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8889 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8893 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8894 & - 0.5d0*(s8d+s12d)
8896 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8905 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8907 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8908 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8909 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8910 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8911 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8913 ss13d = scalar2(b1(1,k),vtemp4d(1))
8914 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8915 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8919 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8920 cd & 16*eel_turn6_num
8922 if (j.lt.nres-1) then
8929 if (l.lt.nres-1) then
8937 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8938 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8939 cgrad ghalf=0.5d0*ggg1(ll)
8941 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8942 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8943 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8944 & +ekont*derx_turn(ll,2,1)
8945 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8946 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8947 & +ekont*derx_turn(ll,4,1)
8948 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8949 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8950 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8951 cgrad ghalf=0.5d0*ggg2(ll)
8953 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8954 & +ekont*derx_turn(ll,2,2)
8955 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8956 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8957 & +ekont*derx_turn(ll,4,2)
8958 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8959 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8960 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8965 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8970 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8976 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8981 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8985 cd write (2,*) iii,g_corr6_loc(iii)
8988 eello_turn6=ekont*eel_turn6
8989 cd write (2,*) 'ekont',ekont
8990 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8994 crc-------------------------------------------------
8995 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8996 subroutine Eliptransfer(eliptran)
8997 implicit real*8 (a-h,o-z)
8998 include 'DIMENSIONS'
8999 include 'COMMON.GEO'
9000 include 'COMMON.VAR'
9001 include 'COMMON.LOCAL'
9002 include 'COMMON.CHAIN'
9003 include 'COMMON.DERIV'
9004 include 'COMMON.INTERACT'
9005 include 'COMMON.IOUNITS'
9006 include 'COMMON.CALC'
9007 include 'COMMON.CONTROL'
9008 include 'COMMON.SPLITELE'
9009 include 'COMMON.SBRIDGE'
9010 C this is done by Adasko
9014 C--bordliptop-- buffore starts
9015 C--bufliptop--- here true lipid starts
9017 C--buflipbot--- lipid ends buffore starts
9018 C--bordlipbot--buffore ends
9022 if (itype(i).eq.ntyp1) cycle
9024 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9025 if (positi.le.0) positi=positi+boxzsize
9027 C first for peptide groups
9028 c for each residue check if it is in lipid or lipid water border area
9029 if ((positi.gt.bordlipbot)
9030 &.and.(positi.lt.bordliptop)) then
9031 C the energy transfer exist
9032 if (positi.lt.buflipbot) then
9033 C what fraction I am in
9035 & ((positi-bordlipbot)/lipbufthick)
9036 C lipbufthick is thickenes of lipid buffore
9037 sslip=sscalelip(fracinbuf)
9038 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9039 eliptran=eliptran+sslip*pepliptran
9040 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9041 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9042 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9043 elseif (positi.gt.bufliptop) then
9044 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9045 sslip=sscalelip(fracinbuf)
9046 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9047 eliptran=eliptran+sslip*pepliptran
9048 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9049 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9050 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9051 C print *, "doing sscalefor top part"
9052 C print *,i,sslip,fracinbuf,ssgradlip
9054 eliptran=eliptran+pepliptran
9055 C print *,"I am in true lipid"
9058 C eliptran=elpitran+0.0 ! I am in water
9061 C print *, "nic nie bylo w lipidzie?"
9062 C now multiply all by the peptide group transfer factor
9063 C eliptran=eliptran*pepliptran
9064 C now the same for side chains
9067 if (itype(i).eq.ntyp1) cycle
9068 positi=(mod(c(3,i+nres),boxzsize))
9069 if (positi.le.0) positi=positi+boxzsize
9070 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9071 c for each residue check if it is in lipid or lipid water border area
9072 C respos=mod(c(3,i+nres),boxzsize)
9073 C print *,positi,bordlipbot,buflipbot
9074 if ((positi.gt.bordlipbot)
9075 & .and.(positi.lt.bordliptop)) then
9076 C the energy transfer exist
9077 if (positi.lt.buflipbot) then
9079 & ((positi-bordlipbot)/lipbufthick)
9080 C lipbufthick is thickenes of lipid buffore
9081 sslip=sscalelip(fracinbuf)
9082 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9083 eliptran=eliptran+sslip*liptranene(itype(i))
9084 gliptranx(3,i)=gliptranx(3,i)
9085 &+ssgradlip*liptranene(itype(i))
9086 gliptranc(3,i-1)= gliptranc(3,i-1)
9087 &+ssgradlip*liptranene(itype(i))
9088 C print *,"doing sccale for lower part"
9089 elseif (positi.gt.bufliptop) then
9091 &((bordliptop-positi)/lipbufthick)
9092 sslip=sscalelip(fracinbuf)
9093 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9094 eliptran=eliptran+sslip*liptranene(itype(i))
9095 gliptranx(3,i)=gliptranx(3,i)
9096 &+ssgradlip*liptranene(itype(i))
9097 gliptranc(3,i-1)= gliptranc(3,i-1)
9098 &+ssgradlip*liptranene(itype(i))
9099 C print *, "doing sscalefor top part",sslip,fracinbuf
9101 eliptran=eliptran+liptranene(itype(i))
9102 C print *,"I am in true lipid"
9104 endif ! if in lipid or buffor
9106 C eliptran=elpitran+0.0 ! I am in water
9112 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9114 SUBROUTINE MATVEC2(A1,V1,V2)
9115 implicit real*8 (a-h,o-z)
9116 include 'DIMENSIONS'
9117 DIMENSION A1(2,2),V1(2),V2(2)
9121 c 3 VI=VI+A1(I,K)*V1(K)
9125 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9126 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9131 C---------------------------------------
9132 SUBROUTINE MATMAT2(A1,A2,A3)
9133 implicit real*8 (a-h,o-z)
9134 include 'DIMENSIONS'
9135 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9136 c DIMENSION AI3(2,2)
9140 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9146 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9147 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9148 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9149 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9157 c-------------------------------------------------------------------------
9158 double precision function scalar2(u,v)
9160 double precision u(2),v(2)
9163 scalar2=u(1)*v(1)+u(2)*v(2)
9167 C-----------------------------------------------------------------------------
9169 subroutine transpose2(a,at)
9171 double precision a(2,2),at(2,2)
9178 c--------------------------------------------------------------------------
9179 subroutine transpose(n,a,at)
9182 double precision a(n,n),at(n,n)
9190 C---------------------------------------------------------------------------
9191 subroutine prodmat3(a1,a2,kk,transp,prod)
9194 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9196 crc double precision auxmat(2,2),prod_(2,2)
9199 crc call transpose2(kk(1,1),auxmat(1,1))
9200 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9201 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9203 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9204 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9205 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9206 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9207 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9208 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9209 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9210 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9213 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9214 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9216 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9217 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9218 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9219 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9220 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9221 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9222 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9223 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9226 c call transpose2(a2(1,1),a2t(1,1))
9229 crc print *,((prod_(i,j),i=1,2),j=1,2)
9230 crc print *,((prod(i,j),i=1,2),j=1,2)
9234 C-----------------------------------------------------------------------------
9235 double precision function scalar(u,v)
9237 double precision u(3),v(3)
9247 C-----------------------------------------------------------------------
9248 double precision function sscale(r)
9249 double precision r,gamm
9250 include "COMMON.SPLITELE"
9251 if(r.lt.r_cut-rlamb) then
9253 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9254 gamm=(r-(r_cut-rlamb))/rlamb
9255 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9261 C-----------------------------------------------------------------------
9262 C-----------------------------------------------------------------------
9263 double precision function sscagrad(r)
9264 double precision r,gamm
9265 include "COMMON.SPLITELE"
9266 if(r.lt.r_cut-rlamb) then
9268 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9269 gamm=(r-(r_cut-rlamb))/rlamb
9270 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9276 C-----------------------------------------------------------------------
9277 C-----------------------------------------------------------------------
9278 double precision function sscalelip(r)
9279 double precision r,gamm
9280 include "COMMON.SPLITELE"
9281 C if(r.lt.r_cut-rlamb) then
9283 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9284 C gamm=(r-(r_cut-rlamb))/rlamb
9285 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9291 C-----------------------------------------------------------------------
9292 double precision function sscagradlip(r)
9293 double precision r,gamm
9294 include "COMMON.SPLITELE"
9295 C if(r.lt.r_cut-rlamb) then
9297 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9298 C gamm=(r-(r_cut-rlamb))/rlamb
9299 sscagradlip=r*(6*r-6.0d0)
9306 C-----------------------------------------------------------------------
9307 subroutine set_shield_fac
9308 implicit real*8 (a-h,o-z)
9309 include 'DIMENSIONS'
9310 include 'COMMON.CHAIN'
9311 include 'COMMON.DERIV'
9312 include 'COMMON.IOUNITS'
9313 include 'COMMON.SHIELD'
9314 include 'COMMON.INTERACT'
9315 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9316 double precision div77_81/0.974996043d0/,
9317 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9319 C the vector between center of side_chain and peptide group
9320 double precision pep_side(3),long,side_calf(3),
9321 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9322 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9323 C the line belowe needs to be changed for FGPROC>1
9325 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9327 Cif there two consequtive dummy atoms there is no peptide group between them
9328 C the line below has to be changed for FGPROC>1
9331 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9335 C first lets set vector conecting the ithe side-chain with kth side-chain
9336 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9338 C and vector conecting the side-chain with its proper calfa
9339 side_calf(j)=c(j,k+nres)-c(j,k)
9340 C side_calf(j)=2.0d0
9341 pept_group(j)=c(j,i)-c(j,i+1)
9342 C lets have their lenght
9343 dist_pep_side=pep_side(j)**2+dist_pep_side
9344 dist_side_calf=dist_side_calf+side_calf(j)**2
9345 dist_pept_group=dist_pept_group+pept_group(j)**2
9347 dist_pep_side=dsqrt(dist_pep_side)
9348 dist_pept_group=dsqrt(dist_pept_group)
9349 dist_side_calf=dsqrt(dist_side_calf)
9351 pep_side_norm(j)=pep_side(j)/dist_pep_side
9352 side_calf_norm(j)=dist_side_calf
9354 C now sscale fraction
9355 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9356 C print *,buff_shield,"buff"
9358 if (sh_frac_dist.le.0.0) cycle
9359 C If we reach here it means that this side chain reaches the shielding sphere
9360 C Lets add him to the list for gradient
9361 ishield_list(i)=ishield_list(i)+1
9362 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9363 C this list is essential otherwise problem would be O3
9364 shield_list(ishield_list(i),i)=k
9365 C Lets have the sscale value
9366 if (sh_frac_dist.gt.1.0) then
9367 scale_fac_dist=1.0d0
9369 sh_frac_dist_grad(j)=0.0d0
9372 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9373 & *(2.0*sh_frac_dist-3.0d0)
9374 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9375 & /dist_pep_side/buff_shield*0.5
9376 C remember for the final gradient multiply sh_frac_dist_grad(j)
9377 C for side_chain by factor -2 !
9379 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9380 C print *,"jestem",scale_fac_dist,fac_help_scale,
9381 C & sh_frac_dist_grad(j)
9384 C if ((i.eq.3).and.(k.eq.2)) then
9385 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9389 C this is what is now we have the distance scaling now volume...
9390 short=short_r_sidechain(itype(k))
9391 long=long_r_sidechain(itype(k))
9392 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9395 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9398 costhet_grad(j)=costhet_fac*pep_side(j)
9400 C remember for the final gradient multiply costhet_grad(j)
9401 C for side_chain by factor -2 !
9402 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9403 C pep_side0pept_group is vector multiplication
9404 pep_side0pept_group=0.0
9406 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9408 cosalfa=(pep_side0pept_group/
9409 & (dist_pep_side*dist_side_calf))
9410 fac_alfa_sin=1.0-cosalfa**2
9411 fac_alfa_sin=dsqrt(fac_alfa_sin)
9412 rkprim=fac_alfa_sin*(long-short)+short
9414 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9415 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9418 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9419 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9420 &*(long-short)/fac_alfa_sin*cosalfa/
9421 &((dist_pep_side*dist_side_calf))*
9422 &((side_calf(j))-cosalfa*
9423 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9425 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9426 &*(long-short)/fac_alfa_sin*cosalfa
9427 &/((dist_pep_side*dist_side_calf))*
9429 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9432 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9435 C now the gradient...
9436 C grad_shield is gradient of Calfa for peptide groups
9437 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9439 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9440 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9442 grad_shield(j,i)=grad_shield(j,i)
9443 C gradient po skalowaniu
9444 & +(sh_frac_dist_grad(j)
9445 C gradient po costhet
9446 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9447 &-scale_fac_dist*(cosphi_grad_long(j))
9448 &/(1.0-cosphi) )*div77_81
9450 C grad_shield_side is Cbeta sidechain gradient
9451 grad_shield_side(j,ishield_list(i),i)=
9452 & (sh_frac_dist_grad(j)*(-2.0d0)
9453 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9454 & +scale_fac_dist*(cosphi_grad_long(j))
9455 & *2.0d0/(1.0-cosphi))
9456 & *div77_81*VofOverlap
9458 grad_shield_loc(j,ishield_list(i),i)=
9459 & scale_fac_dist*cosphi_grad_loc(j)
9460 & *2.0d0/(1.0-cosphi)
9461 & *div77_81*VofOverlap
9463 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9465 fac_shield(i)=VolumeTotal*div77_81+div4_81
9466 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9470 C--------------------------------------------------------------------------
9471 C first for shielding is setting of function of side-chains
9472 subroutine set_shield_fac2
9473 implicit real*8 (a-h,o-z)
9474 include 'DIMENSIONS'
9475 include 'COMMON.CHAIN'
9476 include 'COMMON.DERIV'
9477 include 'COMMON.IOUNITS'
9478 include 'COMMON.SHIELD'
9479 include 'COMMON.INTERACT'
9480 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9481 double precision div77_81/0.974996043d0/,
9482 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9484 C the vector between center of side_chain and peptide group
9485 double precision pep_side(3),long,side_calf(3),
9486 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9487 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9488 C the line belowe needs to be changed for FGPROC>1
9490 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9492 Cif there two consequtive dummy atoms there is no peptide group between them
9493 C the line below has to be changed for FGPROC>1
9496 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9500 C first lets set vector conecting the ithe side-chain with kth side-chain
9501 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9503 C and vector conecting the side-chain with its proper calfa
9504 side_calf(j)=c(j,k+nres)-c(j,k)
9505 C side_calf(j)=2.0d0
9506 pept_group(j)=c(j,i)-c(j,i+1)
9507 C lets have their lenght
9508 dist_pep_side=pep_side(j)**2+dist_pep_side
9509 dist_side_calf=dist_side_calf+side_calf(j)**2
9510 dist_pept_group=dist_pept_group+pept_group(j)**2
9512 dist_pep_side=dsqrt(dist_pep_side)
9513 dist_pept_group=dsqrt(dist_pept_group)
9514 dist_side_calf=dsqrt(dist_side_calf)
9516 pep_side_norm(j)=pep_side(j)/dist_pep_side
9517 side_calf_norm(j)=dist_side_calf
9519 C now sscale fraction
9520 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9521 C print *,buff_shield,"buff"
9523 if (sh_frac_dist.le.0.0) cycle
9524 C If we reach here it means that this side chain reaches the shielding sphere
9525 C Lets add him to the list for gradient
9526 ishield_list(i)=ishield_list(i)+1
9527 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9528 C this list is essential otherwise problem would be O3
9529 shield_list(ishield_list(i),i)=k
9530 C Lets have the sscale value
9531 if (sh_frac_dist.gt.1.0) then
9532 scale_fac_dist=1.0d0
9534 sh_frac_dist_grad(j)=0.0d0
9537 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9538 & *(2.0d0*sh_frac_dist-3.0d0)
9539 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9540 & /dist_pep_side/buff_shield*0.5d0
9541 C remember for the final gradient multiply sh_frac_dist_grad(j)
9542 C for side_chain by factor -2 !
9544 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9545 C sh_frac_dist_grad(j)=0.0d0
9546 C scale_fac_dist=1.0d0
9547 C print *,"jestem",scale_fac_dist,fac_help_scale,
9548 C & sh_frac_dist_grad(j)
9551 C this is what is now we have the distance scaling now volume...
9552 short=short_r_sidechain(itype(k))
9553 long=long_r_sidechain(itype(k))
9554 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9555 sinthet=short/dist_pep_side*costhet
9559 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9560 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9561 C & -short/dist_pep_side**2/costhet)
9564 costhet_grad(j)=costhet_fac*pep_side(j)
9566 C remember for the final gradient multiply costhet_grad(j)
9567 C for side_chain by factor -2 !
9568 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9569 C pep_side0pept_group is vector multiplication
9570 pep_side0pept_group=0.0d0
9572 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9574 cosalfa=(pep_side0pept_group/
9575 & (dist_pep_side*dist_side_calf))
9576 fac_alfa_sin=1.0d0-cosalfa**2
9577 fac_alfa_sin=dsqrt(fac_alfa_sin)
9578 rkprim=fac_alfa_sin*(long-short)+short
9582 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9584 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9585 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9589 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9590 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9591 &*(long-short)/fac_alfa_sin*cosalfa/
9592 &((dist_pep_side*dist_side_calf))*
9593 &((side_calf(j))-cosalfa*
9594 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9595 C cosphi_grad_long(j)=0.0d0
9596 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9597 &*(long-short)/fac_alfa_sin*cosalfa
9598 &/((dist_pep_side*dist_side_calf))*
9600 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9601 C cosphi_grad_loc(j)=0.0d0
9603 C print *,sinphi,sinthet
9604 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9607 C now the gradient...
9609 grad_shield(j,i)=grad_shield(j,i)
9610 C gradient po skalowaniu
9611 & +(sh_frac_dist_grad(j)*VofOverlap
9612 C gradient po costhet
9613 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9614 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9615 & sinphi/sinthet*costhet*costhet_grad(j)
9616 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9618 C grad_shield_side is Cbeta sidechain gradient
9619 grad_shield_side(j,ishield_list(i),i)=
9620 & (sh_frac_dist_grad(j)*(-2.0d0)
9622 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9623 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9624 & sinphi/sinthet*costhet*costhet_grad(j)
9625 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9628 grad_shield_loc(j,ishield_list(i),i)=
9629 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9630 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9631 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9635 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9637 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9638 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9639 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9643 C--------------------------------------------------------------------------
9644 double precision function tschebyshev(m,n,x,y)
9646 include "DIMENSIONS"
9648 double precision x(n),y,yy(0:maxvar),aux
9649 c Tschebyshev polynomial. Note that the first term is omitted
9650 c m=0: the constant term is included
9651 c m=1: the constant term is not included
9655 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9664 C--------------------------------------------------------------------------
9665 double precision function gradtschebyshev(m,n,x,y)
9667 include "DIMENSIONS"
9669 double precision x(n+1),y,yy(0:maxvar),aux
9670 c Tschebyshev polynomial. Note that the first term is omitted
9671 c m=0: the constant term is included
9672 c m=1: the constant term is not included
9676 yy(i)=2*y*yy(i-1)-yy(i-2)
9680 aux=aux+x(i+1)*yy(i)*(i+1)
9681 C print *, x(i+1),yy(i),i
9686 c----------------------------------------------------------------------------
9687 double precision function sscale2(r,r_cut,r0,rlamb)
9689 double precision r,gamm,r_cut,r0,rlamb,rr
9691 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9692 c write (2,*) "rr",rr
9693 if(rr.lt.r_cut-rlamb) then
9695 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9696 gamm=(rr-(r_cut-rlamb))/rlamb
9697 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9703 C-----------------------------------------------------------------------
9704 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9706 double precision r,gamm,r_cut,r0,rlamb,rr
9708 if(rr.lt.r_cut-rlamb) then
9710 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9711 gamm=(rr-(r_cut-rlamb))/rlamb
9713 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9715 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9722 c----------------------------------------------------------------------------
9723 subroutine e_saxs(Esaxs_constr)
9725 include 'DIMENSIONS'
9728 include "COMMON.SETUP"
9731 include 'COMMON.SBRIDGE'
9732 include 'COMMON.CHAIN'
9733 include 'COMMON.GEO'
9734 include 'COMMON.LOCAL'
9735 include 'COMMON.INTERACT'
9736 include 'COMMON.VAR'
9737 include 'COMMON.IOUNITS'
9738 include 'COMMON.DERIV'
9739 include 'COMMON.CONTROL'
9740 include 'COMMON.NAMES'
9741 include 'COMMON.FFIELD'
9742 include 'COMMON.LANGEVIN'
9743 include 'COMMON.SAXS'
9745 double precision Esaxs_constr
9746 integer i,iint,j,k,l
9747 double precision PgradC(maxSAXS,3,maxres),
9748 & PgradX(maxSAXS,3,maxres)
9750 double precision PgradC_(maxSAXS,3,maxres),
9751 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9753 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9754 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9755 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9756 & auxX,auxX1,CACAgrad,Cnorm
9757 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9758 double precision dist
9760 c SAXS restraint penalty function
9762 write(iout,*) "------- SAXS penalty function start -------"
9763 write (iout,*) "nsaxs",nsaxs
9764 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9765 write (iout,*) "Psaxs"
9767 write (iout,'(i5,e15.5)') i, Psaxs(i)
9770 Esaxs_constr = 0.0d0
9780 do i=iatsc_s,iatsc_e
9781 if (itype(i).eq.ntyp1) cycle
9782 do iint=1,nint_gr(i)
9783 do j=istart(i,iint),iend(i,iint)
9784 if (itype(j).eq.ntyp1) cycle
9787 dijCASC=dist(i,j+nres)
9788 dijSCCA=dist(i+nres,j)
9789 dijSCSC=dist(i+nres,j+nres)
9790 sigma2CACA=2.0d0/(pstok**2)
9791 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9792 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9793 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9796 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9797 if (itype(j).ne.10) then
9798 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9802 if (itype(i).ne.10) then
9803 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9807 if (itype(i).ne.10 .and. itype(j).ne.10) then
9808 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9812 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9814 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9816 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9817 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9818 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9819 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9822 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9823 PgradC(k,l,i) = PgradC(k,l,i)-aux
9824 PgradC(k,l,j) = PgradC(k,l,j)+aux
9826 if (itype(j).ne.10) then
9827 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9828 PgradC(k,l,i) = PgradC(k,l,i)-aux
9829 PgradC(k,l,j) = PgradC(k,l,j)+aux
9830 PgradX(k,l,j) = PgradX(k,l,j)+aux
9833 if (itype(i).ne.10) then
9834 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9835 PgradX(k,l,i) = PgradX(k,l,i)-aux
9836 PgradC(k,l,i) = PgradC(k,l,i)-aux
9837 PgradC(k,l,j) = PgradC(k,l,j)+aux
9840 if (itype(i).ne.10 .and. itype(j).ne.10) then
9841 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9842 PgradC(k,l,i) = PgradC(k,l,i)-aux
9843 PgradC(k,l,j) = PgradC(k,l,j)+aux
9844 PgradX(k,l,i) = PgradX(k,l,i)-aux
9845 PgradX(k,l,j) = PgradX(k,l,j)+aux
9851 sigma2CACA=scal_rad**2*0.25d0/
9852 & (restok(itype(j))**2+restok(itype(i))**2)
9854 IF (saxs_cutoff.eq.0) THEN
9857 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9858 Pcalc(k) = Pcalc(k)+expCACA
9859 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9861 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9862 PgradC(k,l,i) = PgradC(k,l,i)-aux
9863 PgradC(k,l,j) = PgradC(k,l,j)+aux
9867 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9870 c write (2,*) "ijk",i,j,k
9871 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9872 if (sss2.eq.0.0d0) cycle
9873 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9874 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9875 Pcalc(k) = Pcalc(k)+expCACA
9877 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9879 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9880 & ssgrad2*expCACA/sss2
9883 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9884 PgradC(k,l,i) = PgradC(k,l,i)+aux
9885 PgradC(k,l,j) = PgradC(k,l,j)-aux
9894 if (nfgtasks.gt.1) then
9895 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9896 & MPI_SUM,king,FG_COMM,IERR)
9897 if (fg_rank.eq.king) then
9899 Pcalc(k) = Pcalc_(k)
9902 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9903 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9904 if (fg_rank.eq.king) then
9908 PgradC(k,l,i) = PgradC_(k,l,i)
9914 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9915 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9916 if (fg_rank.eq.king) then
9920 PgradX(k,l,i) = PgradX_(k,l,i)
9929 if (fg_rank.eq.king) then
9933 Cnorm = Cnorm + Pcalc(k)
9935 Esaxs_constr = dlog(Cnorm)-wsaxs0
9937 if (Pcalc(k).gt.0.0d0)
9938 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9940 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9944 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9954 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9955 auxC1 = auxC1+PgradC(k,l,i)
9957 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9958 auxX1 = auxX1+PgradX(k,l,i)
9961 gsaxsC(l,i) = auxC - auxC1/Cnorm
9963 gsaxsX(l,i) = auxX - auxX1/Cnorm
9965 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9966 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9974 c----------------------------------------------------------------------------
9975 subroutine e_saxsC(Esaxs_constr)
9977 include 'DIMENSIONS'
9980 include "COMMON.SETUP"
9983 include 'COMMON.SBRIDGE'
9984 include 'COMMON.CHAIN'
9985 include 'COMMON.GEO'
9986 include 'COMMON.LOCAL'
9987 include 'COMMON.INTERACT'
9988 include 'COMMON.VAR'
9989 include 'COMMON.IOUNITS'
9990 include 'COMMON.DERIV'
9991 include 'COMMON.CONTROL'
9992 include 'COMMON.NAMES'
9993 include 'COMMON.FFIELD'
9994 include 'COMMON.LANGEVIN'
9995 include 'COMMON.SAXS'
9997 double precision Esaxs_constr
9998 integer i,iint,j,k,l
9999 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc_,logPtot
10001 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
10003 double precision dk,dijCASPH,dijSCSPH,
10004 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
10005 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10007 c SAXS restraint penalty function
10009 write(iout,*) "------- SAXS penalty function start -------"
10010 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10011 & " isaxs_end",isaxs_end
10012 write (iout,*) "nnt",nnt," ntc",nct
10014 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10015 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10018 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10021 Esaxs_constr = 0.0d0
10023 do j=isaxs_start,isaxs_end
10035 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10037 if (itype(i).ne.10) then
10039 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10042 sigma2CA=2.0d0/pstok**2
10043 sigma2SC=4.0d0/restok(itype(i))**2
10044 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10045 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10046 Pcalc_ = Pcalc_+expCASPH+expSCSPH
10048 write(*,*) "processor i j Pcalc",
10049 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc_
10051 CASPHgrad = sigma2CA*expCASPH
10052 SCSPHgrad = sigma2SC*expSCSPH
10054 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10055 PgradX(l,i) = PgradX(l,i) + aux
10056 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10061 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc_
10062 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc_
10065 logPtot = logPtot - dlog(Pcalc_)
10066 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc_),
10067 c & " logPtot",logPtot
10070 if (nfgtasks.gt.1) then
10071 c write (iout,*) "logPtot before reduction",logPtot
10072 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10073 & MPI_SUM,king,FG_COMM,IERR)
10075 c write (iout,*) "logPtot after reduction",logPtot
10076 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10077 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10078 if (fg_rank.eq.king) then
10081 gsaxsC(l,i) = gsaxsC_(l,i)
10085 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10086 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10087 if (fg_rank.eq.king) then
10090 gsaxsX(l,i) = gsaxsX_(l,i)
10096 Esaxs_constr = logPtot
10099 C--------------------------------------------------------------------------
10100 c MODELLER restraint function
10101 subroutine e_modeller(ehomology_constr)
10102 implicit real*8 (a-h,o-z)
10103 include 'DIMENSIONS'
10104 integer nnn, i, j, k, ki, irec, l
10105 integer katy, odleglosci, test7
10106 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
10107 real*8 distance(max_template),distancek(max_template),
10108 & min_odl,godl(max_template),dih_diff(max_template)
10111 c FP - 30/10/2014 Temporary specifications for homology restraints
10113 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
10115 double precision, dimension (maxres) :: guscdiff,usc_diff
10116 double precision, dimension (max_template) ::
10117 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
10120 include 'COMMON.SBRIDGE'
10121 include 'COMMON.CHAIN'
10122 include 'COMMON.GEO'
10123 include 'COMMON.DERIV'
10124 include 'COMMON.LOCAL'
10125 include 'COMMON.INTERACT'
10126 include 'COMMON.VAR'
10127 include 'COMMON.IOUNITS'
10128 include 'COMMON.CONTROL'
10129 include 'COMMON.HOMRESTR'
10130 include 'COMMON.HOMOLOGY'
10131 include 'COMMON.SETUP'
10132 include 'COMMON.NAMES'
10134 do i=1,max_template
10135 distancek(i)=9999999.9
10140 c Pseudo-energy and gradient from homology restraints (MODELLER-like
10142 C AL 5/2/14 - Introduce list of restraints
10143 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
10145 write(iout,*) "------- dist restrs start -------"
10147 do ii = link_start_homo,link_end_homo
10151 c write (iout,*) "dij(",i,j,") =",dij
10153 do k=1,constr_homology
10154 if(.not.l_homo(k,ii)) then
10158 distance(k)=odl(k,ii)-dij
10159 c write (iout,*) "distance(",k,") =",distance(k)
10161 c For Gaussian-type Urestr
10163 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
10164 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
10165 c write (iout,*) "distancek(",k,") =",distancek(k)
10166 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
10168 c For Lorentzian-type Urestr
10170 if (waga_dist.lt.0.0d0) then
10171 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
10172 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
10173 & (distance(k)**2+sigma_odlir(k,ii)**2))
10177 c min_odl=minval(distancek)
10178 do kk=1,constr_homology
10179 if(l_homo(kk,ii)) then
10180 min_odl=distancek(kk)
10184 do kk=1,constr_homology
10185 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
10186 & min_odl=distancek(kk)
10188 c write (iout,* )"min_odl",min_odl
10190 write (iout,*) "ij dij",i,j,dij
10191 write (iout,*) "distance",(distance(k),k=1,constr_homology)
10192 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
10193 write (iout,* )"min_odl",min_odl
10198 if (waga_dist.ge.0.0d0) then
10204 do k=1,constr_homology
10205 c Nie wiem po co to liczycie jeszcze raz!
10206 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
10207 c & (2*(sigma_odl(i,j,k))**2))
10208 if(.not.l_homo(k,ii)) cycle
10209 if (waga_dist.ge.0.0d0) then
10211 c For Gaussian-type Urestr
10213 godl(k)=dexp(-distancek(k)+min_odl)
10214 odleg2=odleg2+godl(k)
10216 c For Lorentzian-type Urestr
10219 odleg2=odleg2+distancek(k)
10222 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
10223 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
10224 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
10225 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
10228 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10229 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10231 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10232 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10234 if (waga_dist.ge.0.0d0) then
10236 c For Gaussian-type Urestr
10238 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
10240 c For Lorentzian-type Urestr
10243 odleg=odleg+odleg2/constr_homology
10247 c write (iout,*) "odleg",odleg ! sum of -ln-s
10250 c For Gaussian-type Urestr
10252 if (waga_dist.ge.0.0d0) sum_godl=odleg2
10254 do k=1,constr_homology
10255 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10256 c & *waga_dist)+min_odl
10257 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
10259 if(.not.l_homo(k,ii)) cycle
10260 if (waga_dist.ge.0.0d0) then
10261 c For Gaussian-type Urestr
10263 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
10265 c For Lorentzian-type Urestr
10268 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
10269 & sigma_odlir(k,ii)**2)**2)
10271 sum_sgodl=sum_sgodl+sgodl
10273 c sgodl2=sgodl2+sgodl
10274 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
10275 c write(iout,*) "constr_homology=",constr_homology
10276 c write(iout,*) i, j, k, "TEST K"
10278 if (waga_dist.ge.0.0d0) then
10280 c For Gaussian-type Urestr
10282 grad_odl3=waga_homology(iset)*waga_dist
10283 & *sum_sgodl/(sum_godl*dij)
10285 c For Lorentzian-type Urestr
10288 c Original grad expr modified by analogy w Gaussian-type Urestr grad
10289 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
10290 grad_odl3=-waga_homology(iset)*waga_dist*
10291 & sum_sgodl/(constr_homology*dij)
10294 c grad_odl3=sum_sgodl/(sum_godl*dij)
10297 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
10298 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
10299 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10301 ccc write(iout,*) godl, sgodl, grad_odl3
10303 c grad_odl=grad_odl+grad_odl3
10306 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
10307 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
10308 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
10309 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10310 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
10311 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
10312 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
10313 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10314 c if (i.eq.25.and.j.eq.27) then
10315 c write(iout,*) "jik",jik,"i",i,"j",j
10316 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
10317 c write(iout,*) "grad_odl3",grad_odl3
10318 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
10319 c write(iout,*) "ggodl",ggodl
10320 c write(iout,*) "ghpbc(",jik,i,")",
10321 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
10326 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
10327 ccc & dLOG(odleg2),"-odleg=", -odleg
10329 enddo ! ii-loop for dist
10331 write(iout,*) "------- dist restrs end -------"
10332 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
10333 c & waga_d.eq.1.0d0) call sum_gradient
10335 c Pseudo-energy and gradient from dihedral-angle restraints from
10336 c homology templates
10337 c write (iout,*) "End of distance loop"
10340 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
10342 write(iout,*) "------- dih restrs start -------"
10343 do i=idihconstr_start_homo,idihconstr_end_homo
10344 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
10347 do i=idihconstr_start_homo,idihconstr_end_homo
10349 c betai=beta(i,i+1,i+2,i+3)
10351 c write (iout,*) "betai =",betai
10352 do k=1,constr_homology
10353 dih_diff(k)=pinorm(dih(k,i)-betai)
10354 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
10355 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
10356 c & -(6.28318-dih_diff(i,k))
10357 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
10358 c & 6.28318+dih_diff(i,k)
10360 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
10362 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
10364 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
10367 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
10370 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
10371 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
10373 write (iout,*) "i",i," betai",betai," kat2",kat2
10374 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
10376 if (kat2.le.1.0d-14) cycle
10377 kat=kat-dLOG(kat2/constr_homology)
10378 c write (iout,*) "kat",kat ! sum of -ln-s
10380 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
10381 ccc & dLOG(kat2), "-kat=", -kat
10384 c ----------------------------------------------------------------------
10386 c ----------------------------------------------------------------------
10390 do k=1,constr_homology
10392 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
10394 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
10396 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
10397 sum_sgdih=sum_sgdih+sgdih
10399 c grad_dih3=sum_sgdih/sum_gdih
10400 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
10402 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
10403 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
10404 ccc & gloc(nphi+i-3,icg)
10405 gloc(i,icg)=gloc(i,icg)+grad_dih3
10406 c if (i.eq.25) then
10407 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
10409 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
10410 ccc & gloc(nphi+i-3,icg)
10412 enddo ! i-loop for dih
10414 write(iout,*) "------- dih restrs end -------"
10417 c Pseudo-energy and gradient for theta angle restraints from
10418 c homology templates
10419 c FP 01/15 - inserted from econstr_local_test.F, loop structure
10423 c For constr_homology reference structures (FP)
10425 c Uconst_back_tot=0.0d0
10428 c Econstr_back legacy
10431 c do i=ithet_start,ithet_end
10434 c do i=loc_start,loc_end
10436 duscdiff(j,i)=0.0d0
10437 duscdiffx(j,i)=0.0d0
10443 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
10444 c write (iout,*) "waga_theta",waga_theta
10445 if (waga_theta.gt.0.0d0) then
10447 write (iout,*) "usampl",usampl
10448 write(iout,*) "------- theta restrs start -------"
10449 c do i=ithet_start,ithet_end
10450 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
10453 c write (iout,*) "maxres",maxres,"nres",nres
10455 do i=ithet_start,ithet_end
10457 c do i=1,nfrag_back
10458 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10460 c Deviation of theta angles wrt constr_homology ref structures
10462 utheta_i=0.0d0 ! argument of Gaussian for single k
10463 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10464 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
10465 c over residues in a fragment
10466 c write (iout,*) "theta(",i,")=",theta(i)
10467 do k=1,constr_homology
10469 c dtheta_i=theta(j)-thetaref(j,iref)
10470 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
10471 theta_diff(k)=thetatpl(k,i)-theta(i)
10473 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
10474 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
10475 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
10476 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
10477 c Gradient for single Gaussian restraint in subr Econstr_back
10478 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10481 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
10482 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
10486 c Gradient for multiple Gaussian restraint
10487 sum_gtheta=gutheta_i
10489 do k=1,constr_homology
10490 c New generalized expr for multiple Gaussian from Econstr_back
10491 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
10493 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
10494 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
10497 c Final value of gradient using same var as in Econstr_back
10498 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
10499 & *waga_homology(iset)
10500 c dutheta(i)=sum_sgtheta/sum_gtheta
10502 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
10504 Eval=Eval-dLOG(gutheta_i/constr_homology)
10505 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
10506 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
10507 c Uconst_back=Uconst_back+utheta(i)
10508 enddo ! (i-loop for theta)
10510 write(iout,*) "------- theta restrs end -------"
10514 c Deviation of local SC geometry
10516 c Separation of two i-loops (instructed by AL - 11/3/2014)
10518 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
10519 c write (iout,*) "waga_d",waga_d
10522 write(iout,*) "------- SC restrs start -------"
10523 write (iout,*) "Initial duscdiff,duscdiffx"
10524 do i=loc_start,loc_end
10525 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
10526 & (duscdiffx(jik,i),jik=1,3)
10529 do i=loc_start,loc_end
10530 usc_diff_i=0.0d0 ! argument of Gaussian for single k
10531 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10532 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
10533 c write(iout,*) "xxtab, yytab, zztab"
10534 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
10535 do k=1,constr_homology
10537 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10538 c Original sign inverted for calc of gradients (s. Econstr_back)
10539 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10540 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10541 c write(iout,*) "dxx, dyy, dzz"
10542 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10544 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
10545 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
10546 c uscdiffk(k)=usc_diff(i)
10547 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
10548 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
10549 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10550 c & xxref(j),yyref(j),zzref(j)
10555 c Generalized expression for multiple Gaussian acc to that for a single
10556 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
10558 c Original implementation
10559 c sum_guscdiff=guscdiff(i)
10561 c sum_sguscdiff=0.0d0
10562 c do k=1,constr_homology
10563 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
10564 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
10565 c sum_sguscdiff=sum_sguscdiff+sguscdiff
10568 c Implementation of new expressions for gradient (Jan. 2015)
10570 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
10572 do k=1,constr_homology
10574 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
10575 c before. Now the drivatives should be correct
10577 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10578 c Original sign inverted for calc of gradients (s. Econstr_back)
10579 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10580 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10582 c New implementation
10584 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
10585 & sigma_d(k,i) ! for the grad wrt r'
10586 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
10589 c New implementation
10590 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
10592 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
10593 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
10594 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
10595 duscdiff(jik,i)=duscdiff(jik,i)+
10596 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
10597 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
10598 duscdiffx(jik,i)=duscdiffx(jik,i)+
10599 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
10600 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
10603 write(iout,*) "jik",jik,"i",i
10604 write(iout,*) "dxx, dyy, dzz"
10605 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10606 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
10607 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
10608 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
10609 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
10610 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
10611 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
10612 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
10613 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
10614 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
10615 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
10616 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
10617 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
10618 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
10619 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
10626 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
10627 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
10629 c write (iout,*) i," uscdiff",uscdiff(i)
10631 c Put together deviations from local geometry
10633 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
10634 c & wfrag_back(3,i,iset)*uscdiff(i)
10635 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
10636 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
10637 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
10638 c Uconst_back=Uconst_back+usc_diff(i)
10640 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
10642 c New implment: multiplied by sum_sguscdiff
10645 enddo ! (i-loop for dscdiff)
10650 write(iout,*) "------- SC restrs end -------"
10651 write (iout,*) "------ After SC loop in e_modeller ------"
10652 do i=loc_start,loc_end
10653 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
10654 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
10656 if (waga_theta.eq.1.0d0) then
10657 write (iout,*) "in e_modeller after SC restr end: dutheta"
10658 do i=ithet_start,ithet_end
10659 write (iout,*) i,dutheta(i)
10662 if (waga_d.eq.1.0d0) then
10663 write (iout,*) "e_modeller after SC loop: duscdiff/x"
10665 write (iout,*) i,(duscdiff(j,i),j=1,3)
10666 write (iout,*) i,(duscdiffx(j,i),j=1,3)
10671 c Total energy from homology restraints
10673 write (iout,*) "odleg",odleg," kat",kat
10674 write (iout,*) "odleg",odleg," kat",kat
10675 write (iout,*) "Eval",Eval," Erot",Erot
10676 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
10677 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
10678 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
10681 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
10683 c ehomology_constr=odleg+kat
10685 c For Lorentzian-type Urestr
10688 if (waga_dist.ge.0.0d0) then
10690 c For Gaussian-type Urestr
10692 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
10693 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10694 ehomology_constr=waga_dist*odleg+waga_angle*kat+
10695 & waga_theta*Eval+waga_d*Erot
10696 c write (iout,*) "ehomology_constr=",ehomology_constr
10699 c For Lorentzian-type Urestr
10701 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
10702 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10703 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
10704 & waga_theta*Eval+waga_d*Erot
10705 c write (iout,*) "ehomology_constr=",ehomology_constr
10708 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
10709 & "Eval",waga_theta,eval,
10710 & "Erot",waga_d,Erot
10711 write (iout,*) "ehomology_constr",ehomology_constr
10715 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
10716 747 format(a12,i4,i4,i4,f8.3,f8.3)
10717 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
10718 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
10719 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
10720 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)