1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
15 include 'COMMON.FFIELD'
16 include 'COMMON.DERIV'
17 include 'COMMON.INTERACT'
18 include 'COMMON.SBRIDGE'
19 include 'COMMON.CHAIN'
20 include 'COMMON.SHIELD'
21 include 'COMMON.CONTROL'
22 include 'COMMON.TORCNSTR'
23 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)
46 C write(iout,*) 'po elektostatyce'
48 C Calculate electrostatic (H-bonding) energy of the main chain.
52 if (shield_mode.eq.1) then
54 else if (shield_mode.eq.2) then
57 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
58 C write(iout,*) 'po eelec'
60 C Calculate excluded-volume interaction energy between peptide groups
63 call escp(evdw2,evdw2_14)
65 c Calculate the bond-stretching energy
69 C write (iout,*) "estr",estr
71 C Calculate the disulfide-bridge and other energy and the contributions
72 C from other distance constraints.
73 cd print *,'Calling EHPB'
75 cd print *,'EHPB exitted succesfully.'
77 C Calculate the virtual-bond-angle energy.
79 C print *,'Bend energy finished.'
81 if (tor_mode.eq.0) then
84 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
92 if (with_theta_constr) call etheta_constr(ethetacnstr)
93 c call ebend(ebe,ethetacnstr)
94 cd print *,'Bend energy finished.'
96 C Calculate the SC local energy.
99 C print *,'SCLOC energy finished.'
101 C Calculate the virtual-bond torsional energy.
103 if (wtor.gt.0.0d0) then
104 if (tor_mode.eq.0) then
105 call etor(etors,fact(1))
107 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
109 call etor_kcc(etors,fact(1))
115 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
116 c print *,"Processor",myrank," computed Utor"
118 C 6/23/01 Calculate double-torsional energy
120 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
121 call etor_d(etors_d,fact(2))
125 c print *,"Processor",myrank," computed Utord"
127 call eback_sc_corr(esccor)
129 if (wliptran.gt.0) then
130 call Eliptransfer(eliptran)
134 C 12/1/95 Multi-body terms
138 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
139 & .or. wturn6.gt.0.0d0) then
140 c write(iout,*)"calling multibody_eello"
141 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
142 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
143 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
150 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
151 c write (iout,*) "Calling multibody_hbond"
152 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
154 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
155 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
156 call e_saxs(Esaxs_constr)
157 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
158 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
159 call e_saxsC(Esaxs_constr)
160 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
165 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
166 if (constr_homology.ge.1) then
167 call e_modeller(ehomology_constr)
169 ehomology_constr=0.0d0
172 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
174 C BARTEK for dfa test!
175 if (wdfa_dist.gt.0) call edfad(edfadis)
176 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
177 if (wdfa_tor.gt.0) call edfat(edfator)
178 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
179 if (wdfa_nei.gt.0) call edfan(edfanei)
180 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
181 if (wdfa_beta.gt.0) call edfab(edfabet)
182 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
185 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
187 if (shield_mode.gt.0) then
188 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
190 & +fact(1)*wvdwpp*evdw1
191 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
192 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
193 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
194 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
195 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
196 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr+wsaxs*esaxs_constr
197 & +wliptran*eliptran*esaxs_constr
198 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
201 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
203 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
204 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
205 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
206 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
207 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
208 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
209 & +wliptran*eliptran+wsaxs*esaxs_constr
210 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
214 if (shield_mode.gt.0) then
215 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
216 & +welec*fact(1)*(ees+evdw1)
217 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
218 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
219 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
220 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
221 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
222 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
223 & +wliptran*eliptran+wsaxs*esaxs_constr
224 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
227 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
228 & +welec*fact(1)*(ees+evdw1)
229 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
230 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
231 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
232 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
233 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
234 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
235 & +wliptran*eliptran+wsaxs*esaxs_constr
236 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
243 energia(2)=evdw2-evdw2_14
260 energia(8)=eello_turn3
261 energia(9)=eello_turn4
270 energia(20)=edihcnstr
273 energia(24)=ethetacnstr
274 energia(26)=esaxs_constr
275 energia(27)=ehomology_constr
283 if (isnan(etot).ne.0) energia(0)=1.0d+99
285 if (isnan(etot)) energia(0)=1.0d+99
290 idumm=proc_proc(etot,i)
292 call proc_proc(etot,i)
294 if(i.eq.1)energia(0)=1.0d+99
300 call enerprint(energia,fact)
304 C Sum up the components of the Cartesian gradient.
309 if (shield_mode.eq.0) then
310 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
311 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
313 & wstrain*ghpbc(j,i)+
314 & wcorr*fact(3)*gradcorr(j,i)+
315 & wel_loc*fact(2)*gel_loc(j,i)+
316 & wturn3*fact(2)*gcorr3_turn(j,i)+
317 & wturn4*fact(3)*gcorr4_turn(j,i)+
318 & wcorr5*fact(4)*gradcorr5(j,i)+
319 & wcorr6*fact(5)*gradcorr6(j,i)+
320 & wturn6*fact(5)*gcorr6_turn(j,i)+
321 & wsccor*fact(2)*gsccorc(j,i)+
322 & wliptran*gliptranc(j,i)+
323 & wdfa_dist*gdfad(j,i)+
324 & wdfa_tor*gdfat(j,i)+
325 & wdfa_nei*gdfan(j,i)+
326 & wdfa_beta*gdfab(j,i)
327 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
329 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
330 & wsccor*fact(2)*gsccorx(j,i)
331 & +wliptran*gliptranx(j,i)
333 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
334 & +fact(1)*wscp*gvdwc_scp(j,i)+
335 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
337 & wstrain*ghpbc(j,i)+
338 & wcorr*fact(3)*gradcorr(j,i)+
339 & wel_loc*fact(2)*gel_loc(j,i)+
340 & wturn3*fact(2)*gcorr3_turn(j,i)+
341 & wturn4*fact(3)*gcorr4_turn(j,i)+
342 & wcorr5*fact(4)*gradcorr5(j,i)+
343 & wcorr6*fact(5)*gradcorr6(j,i)+
344 & wturn6*fact(5)*gcorr6_turn(j,i)+
345 & wsccor*fact(2)*gsccorc(j,i)
346 & +wliptran*gliptranc(j,i)
347 & +welec*gshieldc(j,i)
348 & +welec*gshieldc_loc(j,i)
349 & +wcorr*gshieldc_ec(j,i)
350 & +wcorr*gshieldc_loc_ec(j,i)
351 & +wturn3*gshieldc_t3(j,i)
352 & +wturn3*gshieldc_loc_t3(j,i)
353 & +wturn4*gshieldc_t4(j,i)
354 & +wturn4*gshieldc_loc_t4(j,i)
355 & +wel_loc*gshieldc_ll(j,i)
356 & +wel_loc*gshieldc_loc_ll(j,i)+
357 & wdfa_dist*gdfad(j,i)+
358 & wdfa_tor*gdfat(j,i)+
359 & wdfa_nei*gdfan(j,i)+
360 & wdfa_beta*gdfab(j,i)
361 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
362 & +fact(1)*wscp*gradx_scp(j,i)+
364 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
365 & wsccor*fact(2)*gsccorx(j,i)
366 & +wliptran*gliptranx(j,i)
367 & +welec*gshieldx(j,i)
368 & +wcorr*gshieldx_ec(j,i)
369 & +wturn3*gshieldx_t3(j,i)
370 & +wturn4*gshieldx_t4(j,i)
371 & +wel_loc*gshieldx_ll(j,i)
377 if (shield_mode.eq.0) then
378 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
379 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
381 & wcorr*fact(3)*gradcorr(j,i)+
382 & wel_loc*fact(2)*gel_loc(j,i)+
383 & wturn3*fact(2)*gcorr3_turn(j,i)+
384 & wturn4*fact(3)*gcorr4_turn(j,i)+
385 & wcorr5*fact(4)*gradcorr5(j,i)+
386 & wcorr6*fact(5)*gradcorr6(j,i)+
387 & wturn6*fact(5)*gcorr6_turn(j,i)+
388 & wsccor*fact(2)*gsccorc(j,i)
389 & +wliptran*gliptranc(j,i)+
390 & wdfa_dist*gdfad(j,i)+
391 & wdfa_tor*gdfat(j,i)+
392 & wdfa_nei*gdfan(j,i)+
393 & wdfa_beta*gdfab(j,i)
395 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
397 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
398 & wsccor*fact(1)*gsccorx(j,i)
399 & +wliptran*gliptranx(j,i)
401 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
402 & fact(1)*wscp*gvdwc_scp(j,i)+
403 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
405 & wcorr*fact(3)*gradcorr(j,i)+
406 & wel_loc*fact(2)*gel_loc(j,i)+
407 & wturn3*fact(2)*gcorr3_turn(j,i)+
408 & wturn4*fact(3)*gcorr4_turn(j,i)+
409 & wcorr5*fact(4)*gradcorr5(j,i)+
410 & wcorr6*fact(5)*gradcorr6(j,i)+
411 & wturn6*fact(5)*gcorr6_turn(j,i)+
412 & wsccor*fact(2)*gsccorc(j,i)
413 & +wliptran*gliptranc(j,i)
414 & +welec*gshieldc(j,i)
415 & +welec*gshieldc_loc(j,i)
416 & +wcorr*gshieldc_ec(j,i)
417 & +wcorr*gshieldc_loc_ec(j,i)
418 & +wturn3*gshieldc_t3(j,i)
419 & +wturn3*gshieldc_loc_t3(j,i)
420 & +wturn4*gshieldc_t4(j,i)
421 & +wturn4*gshieldc_loc_t4(j,i)
422 & +wel_loc*gshieldc_ll(j,i)
423 & +wel_loc*gshieldc_loc_ll(j,i)+
424 & wdfa_dist*gdfad(j,i)+
425 & wdfa_tor*gdfat(j,i)+
426 & wdfa_nei*gdfan(j,i)+
427 & wdfa_beta*gdfab(j,i)
428 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
429 & fact(1)*wscp*gradx_scp(j,i)+
431 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
432 & wsccor*fact(1)*gsccorx(j,i)
433 & +wliptran*gliptranx(j,i)
434 & +welec*gshieldx(j,i)
435 & +wcorr*gshieldx_ec(j,i)
436 & +wturn3*gshieldx_t3(j,i)
437 & +wturn4*gshieldx_t4(j,i)
438 & +wel_loc*gshieldx_ll(j,i)
447 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
448 & +wcorr5*fact(4)*g_corr5_loc(i)
449 & +wcorr6*fact(5)*g_corr6_loc(i)
450 & +wturn4*fact(3)*gel_loc_turn4(i)
451 & +wturn3*fact(2)*gel_loc_turn3(i)
452 & +wturn6*fact(5)*gel_loc_turn6(i)
453 & +wel_loc*fact(2)*gel_loc_loc(i)
454 c & +wsccor*fact(1)*gsccor_loc(i)
455 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
458 if (dyn_ss) call dyn_set_nss
461 C------------------------------------------------------------------------
462 subroutine enerprint(energia,fact)
463 implicit real*8 (a-h,o-z)
465 include 'DIMENSIONS.ZSCOPT'
466 include 'COMMON.IOUNITS'
467 include 'COMMON.FFIELD'
468 include 'COMMON.SBRIDGE'
469 include 'COMMON.CONTROL'
470 double precision energia(0:max_ene),fact(6)
472 evdw=energia(1)+fact(6)*energia(21)
474 evdw2=energia(2)+energia(17)
486 eello_turn3=energia(8)
487 eello_turn4=energia(9)
488 eello_turn6=energia(10)
495 edihcnstr=energia(20)
497 ethetacnstr=energia(24)
500 ehomology_constr=energia(27)
502 edfadis = energia(28)
503 edfator = energia(29)
504 edfanei = energia(30)
505 edfabet = energia(31)
507 write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
508 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
509 & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3),
510 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),eel_loc,
511 & wel_loc*fact(2),eello_turn3,wturn3*fact(2),
512 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
513 & esccor,wsccor*fact(1),edihcnstr,
514 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
515 & etube,wtube,esaxs,wsaxs,ehomology_constr,
516 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
519 10 format (/'Virtual-chain energies:'//
520 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
521 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
522 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
523 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
524 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
525 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
526 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
527 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
528 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
529 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
530 & ' (SS bridges & dist. cnstr.)'/
531 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
532 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
533 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
534 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
535 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
536 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
537 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
538 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
539 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
540 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
541 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
542 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
543 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
544 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
545 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
546 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
547 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
548 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
549 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
550 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
551 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
552 & 'ETOT= ',1pE16.6,' (total)')
555 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
556 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
557 & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3),
558 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
559 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
560 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
561 & esccor,wsccor*fact(1),edihcnstr,
562 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
563 & etube,wtube,esaxs,wsaxs,ehomology_constr,
564 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
567 10 format (/'Virtual-chain energies:'//
568 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
569 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
570 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
571 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
572 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
573 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
574 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
575 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
576 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
577 & ' (SS bridges & dist. restr.)'/
578 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
579 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
580 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
581 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
582 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
583 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
584 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
585 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
586 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
587 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
588 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
589 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
590 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
591 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
592 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
593 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
594 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
595 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
596 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
597 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
598 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
599 & 'ETOT= ',1pE16.6,' (total)')
603 C-----------------------------------------------------------------------
604 subroutine elj(evdw,evdw_t)
606 C This subroutine calculates the interaction energy of nonbonded side chains
607 C assuming the LJ potential of interaction.
609 implicit real*8 (a-h,o-z)
611 include 'DIMENSIONS.ZSCOPT'
612 include "DIMENSIONS.COMPAR"
613 parameter (accur=1.0d-10)
616 include 'COMMON.LOCAL'
617 include 'COMMON.CHAIN'
618 include 'COMMON.DERIV'
619 include 'COMMON.INTERACT'
620 include 'COMMON.TORSION'
621 include 'COMMON.ENEPS'
622 include 'COMMON.SBRIDGE'
623 include 'COMMON.NAMES'
624 include 'COMMON.IOUNITS'
625 include 'COMMON.CONTACTS'
629 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
633 eneps_temp(j,i)=0.0d0
642 if (itypi.eq.ntyp1) cycle
643 itypi1=iabs(itype(i+1))
650 C Calculate SC interaction energy.
653 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
654 cd & 'iend=',iend(i,iint)
655 do j=istart(i,iint),iend(i,iint)
657 if (itypj.eq.ntyp1) cycle
661 C Change 12/1/95 to calculate four-body interactions
662 rij=xj*xj+yj*yj+zj*zj
664 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
665 eps0ij=eps(itypi,itypj)
670 ij=icant(itypi,itypj)
672 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
673 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
676 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
677 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
678 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
679 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
680 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
681 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
682 if (bb.gt.0.0d0) then
689 C Calculate the components of the gradient in DC and X
691 fac=-rrij*(e1+evdwij)
696 gvdwx(k,i)=gvdwx(k,i)-gg(k)
697 gvdwx(k,j)=gvdwx(k,j)+gg(k)
701 gvdwc(l,k)=gvdwc(l,k)+gg(l)
706 C 12/1/95, revised on 5/20/97
708 C Calculate the contact function. The ith column of the array JCONT will
709 C contain the numbers of atoms that make contacts with the atom I (of numbers
710 C greater than I). The arrays FACONT and GACONT will contain the values of
711 C the contact function and its derivative.
713 C Uncomment next line, if the correlation interactions include EVDW explicitly.
714 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
715 C Uncomment next line, if the correlation interactions are contact function only
716 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
718 sigij=sigma(itypi,itypj)
719 r0ij=rs0(itypi,itypj)
721 C Check whether the SC's are not too far to make a contact.
724 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
725 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
727 if (fcont.gt.0.0D0) then
728 C If the SC-SC distance if close to sigma, apply spline.
729 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
730 cAdam & fcont1,fprimcont1)
731 cAdam fcont1=1.0d0-fcont1
732 cAdam if (fcont1.gt.0.0d0) then
733 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
734 cAdam fcont=fcont*fcont1
736 C Uncomment following 4 lines to have the geometric average of the epsilon0's
737 cga eps0ij=1.0d0/dsqrt(eps0ij)
739 cga gg(k)=gg(k)*eps0ij
741 cga eps0ij=-evdwij*eps0ij
742 C Uncomment for AL's type of SC correlation interactions.
744 num_conti=num_conti+1
746 facont(num_conti,i)=fcont*eps0ij
747 fprimcont=eps0ij*fprimcont/rij
749 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
750 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
751 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
752 C Uncomment following 3 lines for Skolnick's type of SC correlation.
753 gacont(1,num_conti,i)=-fprimcont*xj
754 gacont(2,num_conti,i)=-fprimcont*yj
755 gacont(3,num_conti,i)=-fprimcont*zj
756 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
757 cd write (iout,'(2i3,3f10.5)')
758 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
764 num_cont(i)=num_conti
769 gvdwc(j,i)=expon*gvdwc(j,i)
770 gvdwx(j,i)=expon*gvdwx(j,i)
774 C******************************************************************************
778 C To save time, the factor of EXPON has been extracted from ALL components
779 C of GVDWC and GRADX. Remember to multiply them by this factor before further
782 C******************************************************************************
785 C-----------------------------------------------------------------------------
786 subroutine eljk(evdw,evdw_t)
788 C This subroutine calculates the interaction energy of nonbonded side chains
789 C assuming the LJK potential of interaction.
791 implicit real*8 (a-h,o-z)
793 include 'DIMENSIONS.ZSCOPT'
794 include "DIMENSIONS.COMPAR"
797 include 'COMMON.LOCAL'
798 include 'COMMON.CHAIN'
799 include 'COMMON.DERIV'
800 include 'COMMON.INTERACT'
801 include 'COMMON.ENEPS'
802 include 'COMMON.IOUNITS'
803 include 'COMMON.NAMES'
808 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
811 eneps_temp(j,i)=0.0d0
818 if (itypi.eq.ntyp1) cycle
819 itypi1=iabs(itype(i+1))
824 C Calculate SC interaction energy.
827 do j=istart(i,iint),iend(i,iint)
829 if (itypj.eq.ntyp1) cycle
833 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
835 e_augm=augm(itypi,itypj)*fac_augm
838 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
839 fac=r_shift_inv**expon
843 ij=icant(itypi,itypj)
844 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
845 & /dabs(eps(itypi,itypj))
846 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
847 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
848 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
849 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
850 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
851 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
852 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
853 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
854 if (bb.gt.0.0d0) then
861 C Calculate the components of the gradient in DC and X
863 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
868 gvdwx(k,i)=gvdwx(k,i)-gg(k)
869 gvdwx(k,j)=gvdwx(k,j)+gg(k)
873 gvdwc(l,k)=gvdwc(l,k)+gg(l)
883 gvdwc(j,i)=expon*gvdwc(j,i)
884 gvdwx(j,i)=expon*gvdwx(j,i)
890 C-----------------------------------------------------------------------------
891 subroutine ebp(evdw,evdw_t)
893 C This subroutine calculates the interaction energy of nonbonded side chains
894 C assuming the Berne-Pechukas potential of interaction.
896 implicit real*8 (a-h,o-z)
898 include 'DIMENSIONS.ZSCOPT'
899 include "DIMENSIONS.COMPAR"
902 include 'COMMON.LOCAL'
903 include 'COMMON.CHAIN'
904 include 'COMMON.DERIV'
905 include 'COMMON.NAMES'
906 include 'COMMON.INTERACT'
907 include 'COMMON.ENEPS'
908 include 'COMMON.IOUNITS'
909 include 'COMMON.CALC'
911 c double precision rrsave(maxdim)
917 eneps_temp(j,i)=0.0d0
922 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
923 c if (icall.eq.0) then
931 if (itypi.eq.ntyp1) cycle
932 itypi1=iabs(itype(i+1))
936 dxi=dc_norm(1,nres+i)
937 dyi=dc_norm(2,nres+i)
938 dzi=dc_norm(3,nres+i)
939 dsci_inv=vbld_inv(i+nres)
941 C Calculate SC interaction energy.
944 do j=istart(i,iint),iend(i,iint)
947 if (itypj.eq.ntyp1) cycle
948 dscj_inv=vbld_inv(j+nres)
949 chi1=chi(itypi,itypj)
950 chi2=chi(itypj,itypi)
957 alf12=0.5D0*(alf1+alf2)
958 C For diagnostics only!!!
971 dxj=dc_norm(1,nres+j)
972 dyj=dc_norm(2,nres+j)
973 dzj=dc_norm(3,nres+j)
974 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
975 cd if (icall.eq.0) then
981 C Calculate the angle-dependent terms of energy & contributions to derivatives.
983 C Calculate whole angle-dependent part of epsilon and contributions
985 fac=(rrij*sigsq)**expon2
988 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
989 eps2der=evdwij*eps3rt
990 eps3der=evdwij*eps2rt
991 evdwij=evdwij*eps2rt*eps3rt
992 ij=icant(itypi,itypj)
993 aux=eps1*eps2rt**2*eps3rt**2
994 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
995 & /dabs(eps(itypi,itypj))
996 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
997 if (bb.gt.0.0d0) then
1000 evdw_t=evdw_t+evdwij
1004 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1006 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1007 & restyp(itypi),i,restyp(itypj),j,
1008 & epsi,sigm,chi1,chi2,chip1,chip2,
1009 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1010 & om1,om2,om12,1.0D0/dsqrt(rrij),
1013 C Calculate gradient components.
1014 e1=e1*eps1*eps2rt**2*eps3rt**2
1015 fac=-expon*(e1+evdwij)
1018 C Calculate radial part of the gradient
1022 C Calculate the angular part of the gradient and sum add the contributions
1023 C to the appropriate components of the Cartesian gradient.
1032 C-----------------------------------------------------------------------------
1033 subroutine egb(evdw,evdw_t)
1035 C This subroutine calculates the interaction energy of nonbonded side chains
1036 C assuming the Gay-Berne potential of interaction.
1038 implicit real*8 (a-h,o-z)
1039 include 'DIMENSIONS'
1040 include 'DIMENSIONS.ZSCOPT'
1041 include "DIMENSIONS.COMPAR"
1042 include 'COMMON.CONTROL'
1043 include 'COMMON.GEO'
1044 include 'COMMON.VAR'
1045 include 'COMMON.LOCAL'
1046 include 'COMMON.CHAIN'
1047 include 'COMMON.DERIV'
1048 include 'COMMON.NAMES'
1049 include 'COMMON.INTERACT'
1050 include 'COMMON.ENEPS'
1051 include 'COMMON.IOUNITS'
1052 include 'COMMON.CALC'
1053 include 'COMMON.SBRIDGE'
1056 integer icant,xshift,yshift,zshift
1060 eneps_temp(j,i)=0.0d0
1063 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1067 c if (icall.gt.0) lprn=.true.
1069 do i=iatsc_s,iatsc_e
1070 itypi=iabs(itype(i))
1071 if (itypi.eq.ntyp1) cycle
1072 itypi1=iabs(itype(i+1))
1076 C returning the ith atom to box
1078 if (xi.lt.0) xi=xi+boxxsize
1080 if (yi.lt.0) yi=yi+boxysize
1082 if (zi.lt.0) zi=zi+boxzsize
1083 if ((zi.gt.bordlipbot)
1084 &.and.(zi.lt.bordliptop)) then
1085 C the energy transfer exist
1086 if (zi.lt.buflipbot) then
1087 C what fraction I am in
1089 & ((zi-bordlipbot)/lipbufthick)
1090 C lipbufthick is thickenes of lipid buffore
1091 sslipi=sscalelip(fracinbuf)
1092 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1093 elseif (zi.gt.bufliptop) then
1094 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1095 sslipi=sscalelip(fracinbuf)
1096 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1106 dxi=dc_norm(1,nres+i)
1107 dyi=dc_norm(2,nres+i)
1108 dzi=dc_norm(3,nres+i)
1109 dsci_inv=vbld_inv(i+nres)
1111 C Calculate SC interaction energy.
1113 do iint=1,nint_gr(i)
1114 do j=istart(i,iint),iend(i,iint)
1115 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1116 call dyn_ssbond_ene(i,j,evdwij)
1118 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1119 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1120 C triple bond artifac removal
1121 do k=j+1,iend(i,iint)
1122 C search over all next residues
1123 if (dyn_ss_mask(k)) then
1124 C check if they are cysteins
1125 C write(iout,*) 'k=',k
1126 call triple_ssbond_ene(i,j,k,evdwij)
1127 C call the energy function that removes the artifical triple disulfide
1128 C bond the soubroutine is located in ssMD.F
1130 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1131 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1132 endif!dyn_ss_mask(k)
1136 itypj=iabs(itype(j))
1137 if (itypj.eq.ntyp1) cycle
1138 dscj_inv=vbld_inv(j+nres)
1139 sig0ij=sigma(itypi,itypj)
1140 chi1=chi(itypi,itypj)
1141 chi2=chi(itypj,itypi)
1148 alf12=0.5D0*(alf1+alf2)
1149 C For diagnostics only!!!
1162 C returning jth atom to box
1164 if (xj.lt.0) xj=xj+boxxsize
1166 if (yj.lt.0) yj=yj+boxysize
1168 if (zj.lt.0) zj=zj+boxzsize
1169 if ((zj.gt.bordlipbot)
1170 &.and.(zj.lt.bordliptop)) then
1171 C the energy transfer exist
1172 if (zj.lt.buflipbot) then
1173 C what fraction I am in
1175 & ((zj-bordlipbot)/lipbufthick)
1176 C lipbufthick is thickenes of lipid buffore
1177 sslipj=sscalelip(fracinbuf)
1178 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1179 elseif (zj.gt.bufliptop) then
1180 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1181 sslipj=sscalelip(fracinbuf)
1182 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1191 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1192 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1193 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1194 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1195 C if (aa.ne.aa_aq(itypi,itypj)) then
1197 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1198 C & bb_aq(itypi,itypj)-bb,
1202 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1203 C checking the distance
1204 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1209 C finding the closest
1213 xj=xj_safe+xshift*boxxsize
1214 yj=yj_safe+yshift*boxysize
1215 zj=zj_safe+zshift*boxzsize
1216 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1217 if(dist_temp.lt.dist_init) then
1227 if (subchap.eq.1) then
1237 dxj=dc_norm(1,nres+j)
1238 dyj=dc_norm(2,nres+j)
1239 dzj=dc_norm(3,nres+j)
1240 c write (iout,*) i,j,xj,yj,zj
1241 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1243 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1244 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1245 if (sss.le.0.0) cycle
1246 C Calculate angle-dependent terms of energy and contributions to their
1251 sig=sig0ij*dsqrt(sigsq)
1252 rij_shift=1.0D0/rij-sig+sig0ij
1253 C I hate to put IF's in the loops, but here don't have another choice!!!!
1254 if (rij_shift.le.0.0D0) then
1259 c---------------------------------------------------------------
1260 rij_shift=1.0D0/rij_shift
1261 fac=rij_shift**expon
1264 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1265 eps2der=evdwij*eps3rt
1266 eps3der=evdwij*eps2rt
1267 evdwij=evdwij*eps2rt*eps3rt
1269 evdw=evdw+evdwij*sss
1271 evdw_t=evdw_t+evdwij*sss
1273 ij=icant(itypi,itypj)
1274 aux=eps1*eps2rt**2*eps3rt**2
1275 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1276 & /dabs(eps(itypi,itypj))
1277 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1278 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1279 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1280 c & aux*e2/eps(itypi,itypj)
1282 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1286 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1287 & restyp(itypi),i,restyp(itypj),j,
1288 & epsi,sigm,chi1,chi2,chip1,chip2,
1289 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1290 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1292 write (iout,*) "partial sum", evdw, evdw_t
1296 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1299 C Calculate gradient components.
1300 e1=e1*eps1*eps2rt**2*eps3rt**2
1301 fac=-expon*(e1+evdwij)*rij_shift
1304 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1305 C Calculate the radial part of the gradient
1309 C Calculate angular part of the gradient.
1312 C write(iout,*) "partial sum", evdw, evdw_t
1319 C-----------------------------------------------------------------------------
1320 subroutine egbv(evdw,evdw_t)
1322 C This subroutine calculates the interaction energy of nonbonded side chains
1323 C assuming the Gay-Berne-Vorobjev potential of interaction.
1325 implicit real*8 (a-h,o-z)
1326 include 'DIMENSIONS'
1327 include 'DIMENSIONS.ZSCOPT'
1328 include "DIMENSIONS.COMPAR"
1329 include 'COMMON.GEO'
1330 include 'COMMON.VAR'
1331 include 'COMMON.LOCAL'
1332 include 'COMMON.CHAIN'
1333 include 'COMMON.DERIV'
1334 include 'COMMON.NAMES'
1335 include 'COMMON.INTERACT'
1336 include 'COMMON.ENEPS'
1337 include 'COMMON.IOUNITS'
1338 include 'COMMON.CALC'
1339 common /srutu/ icall
1345 eneps_temp(j,i)=0.0d0
1350 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1353 c if (icall.gt.0) lprn=.true.
1355 do i=iatsc_s,iatsc_e
1356 itypi=iabs(itype(i))
1357 if (itypi.eq.ntyp1) cycle
1358 itypi1=iabs(itype(i+1))
1362 dxi=dc_norm(1,nres+i)
1363 dyi=dc_norm(2,nres+i)
1364 dzi=dc_norm(3,nres+i)
1365 dsci_inv=vbld_inv(i+nres)
1367 C Calculate SC interaction energy.
1369 do iint=1,nint_gr(i)
1370 do j=istart(i,iint),iend(i,iint)
1372 itypj=iabs(itype(j))
1373 if (itypj.eq.ntyp1) cycle
1374 dscj_inv=vbld_inv(j+nres)
1375 sig0ij=sigma(itypi,itypj)
1376 r0ij=r0(itypi,itypj)
1377 chi1=chi(itypi,itypj)
1378 chi2=chi(itypj,itypi)
1385 alf12=0.5D0*(alf1+alf2)
1386 C For diagnostics only!!!
1399 dxj=dc_norm(1,nres+j)
1400 dyj=dc_norm(2,nres+j)
1401 dzj=dc_norm(3,nres+j)
1402 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1404 C Calculate angle-dependent terms of energy and contributions to their
1408 sig=sig0ij*dsqrt(sigsq)
1409 rij_shift=1.0D0/rij-sig+r0ij
1410 C I hate to put IF's in the loops, but here don't have another choice!!!!
1411 if (rij_shift.le.0.0D0) then
1416 c---------------------------------------------------------------
1417 rij_shift=1.0D0/rij_shift
1418 fac=rij_shift**expon
1421 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1422 eps2der=evdwij*eps3rt
1423 eps3der=evdwij*eps2rt
1424 fac_augm=rrij**expon
1425 e_augm=augm(itypi,itypj)*fac_augm
1426 evdwij=evdwij*eps2rt*eps3rt
1427 if (bb.gt.0.0d0) then
1428 evdw=evdw+evdwij+e_augm
1430 evdw_t=evdw_t+evdwij+e_augm
1432 ij=icant(itypi,itypj)
1433 aux=eps1*eps2rt**2*eps3rt**2
1434 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1435 & /dabs(eps(itypi,itypj))
1436 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1437 c eneps_temp(ij)=eneps_temp(ij)
1438 c & +(evdwij+e_augm)/eps(itypi,itypj)
1440 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1441 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1442 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1443 c & restyp(itypi),i,restyp(itypj),j,
1444 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1445 c & chi1,chi2,chip1,chip2,
1446 c & eps1,eps2rt**2,eps3rt**2,
1447 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1451 C Calculate gradient components.
1452 e1=e1*eps1*eps2rt**2*eps3rt**2
1453 fac=-expon*(e1+evdwij)*rij_shift
1455 fac=rij*fac-2*expon*rrij*e_augm
1456 C Calculate the radial part of the gradient
1460 C Calculate angular part of the gradient.
1468 C-----------------------------------------------------------------------------
1469 subroutine sc_angular
1470 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1471 C om12. Called by ebp, egb, and egbv.
1473 include 'COMMON.CALC'
1477 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1478 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1479 om12=dxi*dxj+dyi*dyj+dzi*dzj
1481 C Calculate eps1(om12) and its derivative in om12
1482 faceps1=1.0D0-om12*chiom12
1483 faceps1_inv=1.0D0/faceps1
1484 eps1=dsqrt(faceps1_inv)
1485 C Following variable is eps1*deps1/dom12
1486 eps1_om12=faceps1_inv*chiom12
1487 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1492 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1493 sigsq=1.0D0-facsig*faceps1_inv
1494 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1495 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1496 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1497 C Calculate eps2 and its derivatives in om1, om2, and om12.
1500 chipom12=chip12*om12
1501 facp=1.0D0-om12*chipom12
1503 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1504 C Following variable is the square root of eps2
1505 eps2rt=1.0D0-facp1*facp_inv
1506 C Following three variables are the derivatives of the square root of eps
1507 C in om1, om2, and om12.
1508 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1509 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1510 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1511 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1512 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1513 C Calculate whole angle-dependent part of epsilon and contributions
1514 C to its derivatives
1517 C----------------------------------------------------------------------------
1519 implicit real*8 (a-h,o-z)
1520 include 'DIMENSIONS'
1521 include 'DIMENSIONS.ZSCOPT'
1522 include 'COMMON.CHAIN'
1523 include 'COMMON.DERIV'
1524 include 'COMMON.CALC'
1525 double precision dcosom1(3),dcosom2(3)
1526 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1527 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1528 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1529 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1531 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1532 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1535 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1538 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1539 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1540 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1541 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1542 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1543 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1546 C Calculate the components of the gradient in DC and X
1550 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1555 c------------------------------------------------------------------------------
1556 subroutine vec_and_deriv
1557 implicit real*8 (a-h,o-z)
1558 include 'DIMENSIONS'
1559 include 'DIMENSIONS.ZSCOPT'
1560 include 'COMMON.IOUNITS'
1561 include 'COMMON.GEO'
1562 include 'COMMON.VAR'
1563 include 'COMMON.LOCAL'
1564 include 'COMMON.CHAIN'
1565 include 'COMMON.VECTORS'
1566 include 'COMMON.DERIV'
1567 include 'COMMON.INTERACT'
1568 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1569 C Compute the local reference systems. For reference system (i), the
1570 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1571 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1573 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1574 if (i.eq.nres-1) then
1575 C Case of the last full residue
1576 C Compute the Z-axis
1577 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1578 costh=dcos(pi-theta(nres))
1579 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1580 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1586 C Compute the derivatives of uz
1588 uzder(2,1,1)=-dc_norm(3,i-1)
1589 uzder(3,1,1)= dc_norm(2,i-1)
1590 uzder(1,2,1)= dc_norm(3,i-1)
1592 uzder(3,2,1)=-dc_norm(1,i-1)
1593 uzder(1,3,1)=-dc_norm(2,i-1)
1594 uzder(2,3,1)= dc_norm(1,i-1)
1597 uzder(2,1,2)= dc_norm(3,i)
1598 uzder(3,1,2)=-dc_norm(2,i)
1599 uzder(1,2,2)=-dc_norm(3,i)
1601 uzder(3,2,2)= dc_norm(1,i)
1602 uzder(1,3,2)= dc_norm(2,i)
1603 uzder(2,3,2)=-dc_norm(1,i)
1606 C Compute the Y-axis
1609 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1612 C Compute the derivatives of uy
1615 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1616 & -dc_norm(k,i)*dc_norm(j,i-1)
1617 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1619 uyder(j,j,1)=uyder(j,j,1)-costh
1620 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1625 uygrad(l,k,j,i)=uyder(l,k,j)
1626 uzgrad(l,k,j,i)=uzder(l,k,j)
1630 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1631 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1632 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1633 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1637 C Compute the Z-axis
1638 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1639 costh=dcos(pi-theta(i+2))
1640 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1645 C Compute the derivatives of uz
1647 uzder(2,1,1)=-dc_norm(3,i+1)
1648 uzder(3,1,1)= dc_norm(2,i+1)
1649 uzder(1,2,1)= dc_norm(3,i+1)
1651 uzder(3,2,1)=-dc_norm(1,i+1)
1652 uzder(1,3,1)=-dc_norm(2,i+1)
1653 uzder(2,3,1)= dc_norm(1,i+1)
1656 uzder(2,1,2)= dc_norm(3,i)
1657 uzder(3,1,2)=-dc_norm(2,i)
1658 uzder(1,2,2)=-dc_norm(3,i)
1660 uzder(3,2,2)= dc_norm(1,i)
1661 uzder(1,3,2)= dc_norm(2,i)
1662 uzder(2,3,2)=-dc_norm(1,i)
1665 C Compute the Y-axis
1668 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1671 C Compute the derivatives of uy
1674 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1675 & -dc_norm(k,i)*dc_norm(j,i+1)
1676 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1678 uyder(j,j,1)=uyder(j,j,1)-costh
1679 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1684 uygrad(l,k,j,i)=uyder(l,k,j)
1685 uzgrad(l,k,j,i)=uzder(l,k,j)
1689 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1690 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1691 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1692 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1698 vbld_inv_temp(1)=vbld_inv(i+1)
1699 if (i.lt.nres-1) then
1700 vbld_inv_temp(2)=vbld_inv(i+2)
1702 vbld_inv_temp(2)=vbld_inv(i)
1707 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1708 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1716 C--------------------------------------------------------------------------
1717 subroutine set_matrices
1718 implicit real*8 (a-h,o-z)
1719 include 'DIMENSIONS'
1723 integer status(MPI_STATUS_SIZE)
1725 include 'DIMENSIONS.ZSCOPT'
1726 include 'COMMON.IOUNITS'
1727 include 'COMMON.GEO'
1728 include 'COMMON.VAR'
1729 include 'COMMON.LOCAL'
1730 include 'COMMON.CHAIN'
1731 include 'COMMON.DERIV'
1732 include 'COMMON.INTERACT'
1733 include 'COMMON.CONTACTS'
1734 include 'COMMON.TORSION'
1735 include 'COMMON.VECTORS'
1736 include 'COMMON.FFIELD'
1737 double precision auxvec(2),auxmat(2,2)
1739 C Compute the virtual-bond-torsional-angle dependent quantities needed
1740 C to calculate the el-loc multibody terms of various order.
1742 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1744 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1745 iti = itype2loc(itype(i-2))
1749 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1750 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1751 iti1 = itype2loc(itype(i-1))
1756 cost1=dcos(theta(i-1))
1757 sint1=dsin(theta(i-1))
1759 sint1cub=sint1sq*sint1
1760 sint1cost1=2*sint1*cost1
1762 write (iout,*) "bnew1",i,iti
1763 write (iout,*) (bnew1(k,1,iti),k=1,3)
1764 write (iout,*) (bnew1(k,2,iti),k=1,3)
1765 write (iout,*) "bnew2",i,iti
1766 write (iout,*) (bnew2(k,1,iti),k=1,3)
1767 write (iout,*) (bnew2(k,2,iti),k=1,3)
1770 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1772 gtb1(k,i-2)=cost1*b1k-sint1sq*
1773 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1774 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1776 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1777 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1780 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1781 cc(1,k,i-2)=sint1sq*aux
1782 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1783 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1784 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1785 dd(1,k,i-2)=sint1sq*aux
1786 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1787 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1789 cc(2,1,i-2)=cc(1,2,i-2)
1790 cc(2,2,i-2)=-cc(1,1,i-2)
1791 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1792 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1793 dd(2,1,i-2)=dd(1,2,i-2)
1794 dd(2,2,i-2)=-dd(1,1,i-2)
1795 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1796 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1799 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1800 EE(l,k,i-2)=sint1sq*aux
1802 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1805 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1806 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1807 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1808 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1810 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1811 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1812 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1814 c b1tilde(1,i-2)=b1(1,i-2)
1815 c b1tilde(2,i-2)=-b1(2,i-2)
1816 c b2tilde(1,i-2)=b2(1,i-2)
1817 c b2tilde(2,i-2)=-b2(2,i-2)
1819 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1820 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1821 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1822 write (iout,*) 'theta=', theta(i-1)
1825 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1826 c iti = itype2loc(itype(i-2))
1830 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1831 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1832 c iti1 = itype2loc(itype(i-1))
1842 CC(k,l,i-2)=ccold(k,l,iti)
1843 DD(k,l,i-2)=ddold(k,l,iti)
1844 EE(k,l,i-2)=eeold(k,l,iti)
1848 b1tilde(1,i-2)= b1(1,i-2)
1849 b1tilde(2,i-2)=-b1(2,i-2)
1850 b2tilde(1,i-2)= b2(1,i-2)
1851 b2tilde(2,i-2)=-b2(2,i-2)
1853 Ctilde(1,1,i-2)= CC(1,1,i-2)
1854 Ctilde(1,2,i-2)= CC(1,2,i-2)
1855 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1856 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1858 Dtilde(1,1,i-2)= DD(1,1,i-2)
1859 Dtilde(1,2,i-2)= DD(1,2,i-2)
1860 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1861 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1863 write(iout,*) "i",i," iti",iti
1864 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1865 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1869 if (i .lt. nres+1) then
1906 if (i .gt. 3 .and. i .lt. nres+1) then
1907 obrot_der(1,i-2)=-sin1
1908 obrot_der(2,i-2)= cos1
1909 Ugder(1,1,i-2)= sin1
1910 Ugder(1,2,i-2)=-cos1
1911 Ugder(2,1,i-2)=-cos1
1912 Ugder(2,2,i-2)=-sin1
1915 obrot2_der(1,i-2)=-dwasin2
1916 obrot2_der(2,i-2)= dwacos2
1917 Ug2der(1,1,i-2)= dwasin2
1918 Ug2der(1,2,i-2)=-dwacos2
1919 Ug2der(2,1,i-2)=-dwacos2
1920 Ug2der(2,2,i-2)=-dwasin2
1922 obrot_der(1,i-2)=0.0d0
1923 obrot_der(2,i-2)=0.0d0
1924 Ugder(1,1,i-2)=0.0d0
1925 Ugder(1,2,i-2)=0.0d0
1926 Ugder(2,1,i-2)=0.0d0
1927 Ugder(2,2,i-2)=0.0d0
1928 obrot2_der(1,i-2)=0.0d0
1929 obrot2_der(2,i-2)=0.0d0
1930 Ug2der(1,1,i-2)=0.0d0
1931 Ug2der(1,2,i-2)=0.0d0
1932 Ug2der(2,1,i-2)=0.0d0
1933 Ug2der(2,2,i-2)=0.0d0
1935 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1936 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1937 iti = itype2loc(itype(i-2))
1941 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1942 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1943 iti1 = itype2loc(itype(i-1))
1947 cd write (iout,*) '*******i',i,' iti1',iti
1948 cd write (iout,*) 'b1',b1(:,iti)
1949 cd write (iout,*) 'b2',b2(:,iti)
1950 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1951 c if (i .gt. iatel_s+2) then
1952 if (i .gt. nnt+2) then
1953 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1955 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1956 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1958 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1959 c & EE(1,2,iti),EE(2,2,i)
1960 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1961 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1962 c write(iout,*) "Macierz EUG",
1963 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
1965 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
1967 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
1968 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
1969 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1970 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
1971 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
1982 DtUg2(l,k,i-2)=0.0d0
1986 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
1987 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
1989 muder(k,i-2)=Ub2der(k,i-2)
1991 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1992 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1993 if (itype(i-1).le.ntyp) then
1994 iti1 = itype2loc(itype(i-1))
2002 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2005 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2006 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2007 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2008 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2009 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2010 & ((ee(l,k,i-2),l=1,2),k=1,2)
2012 cd write (iout,*) 'mu1',mu1(:,i-2)
2013 cd write (iout,*) 'mu2',mu2(:,i-2)
2014 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2017 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2018 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2019 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2020 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2021 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2023 C Vectors and matrices dependent on a single virtual-bond dihedral.
2024 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2025 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2026 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2027 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2028 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2030 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2031 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2032 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2033 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2037 C Matrices dependent on two consecutive virtual-bond dihedrals.
2038 C The order of matrices is from left to right.
2039 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2042 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2044 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2045 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2047 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2048 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2050 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2051 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2052 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2058 C--------------------------------------------------------------------------
2059 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2061 C This subroutine calculates the average interaction energy and its gradient
2062 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2063 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2064 C The potential depends both on the distance of peptide-group centers and on
2065 C the orientation of the CA-CA virtual bonds.
2067 implicit real*8 (a-h,o-z)
2071 include 'DIMENSIONS'
2072 include 'DIMENSIONS.ZSCOPT'
2073 include 'COMMON.CONTROL'
2074 include 'COMMON.IOUNITS'
2075 include 'COMMON.GEO'
2076 include 'COMMON.VAR'
2077 include 'COMMON.LOCAL'
2078 include 'COMMON.CHAIN'
2079 include 'COMMON.DERIV'
2080 include 'COMMON.INTERACT'
2081 include 'COMMON.CONTACTS'
2082 include 'COMMON.TORSION'
2083 include 'COMMON.VECTORS'
2084 include 'COMMON.FFIELD'
2085 include 'COMMON.TIME1'
2086 include 'COMMON.SPLITELE'
2087 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2088 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2089 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2090 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2091 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2092 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2094 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2096 double precision scal_el /1.0d0/
2098 double precision scal_el /0.5d0/
2101 C 13-go grudnia roku pamietnego...
2102 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2103 & 0.0d0,1.0d0,0.0d0,
2104 & 0.0d0,0.0d0,1.0d0/
2105 cd write(iout,*) 'In EELEC'
2107 cd write(iout,*) 'Type',i
2108 cd write(iout,*) 'B1',B1(:,i)
2109 cd write(iout,*) 'B2',B2(:,i)
2110 cd write(iout,*) 'CC',CC(:,:,i)
2111 cd write(iout,*) 'DD',DD(:,:,i)
2112 cd write(iout,*) 'EE',EE(:,:,i)
2114 cd call check_vecgrad
2116 if (icheckgrad.eq.1) then
2118 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2120 dc_norm(k,i)=dc(k,i)*fac
2122 c write (iout,*) 'i',i,' fac',fac
2125 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2126 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2127 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2128 c call vec_and_deriv
2134 time_mat=time_mat+MPI_Wtime()-time01
2138 cd write (iout,*) 'i=',i
2140 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2143 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2144 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2157 cd print '(a)','Enter EELEC'
2158 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2160 gel_loc_loc(i)=0.0d0
2165 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2167 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2169 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2170 do i=iturn3_start,iturn3_end
2172 C write(iout,*) "tu jest i",i
2173 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2174 C changes suggested by Ana to avoid out of bounds
2175 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2176 c & .or.((i+4).gt.nres)
2177 c & .or.((i-1).le.0)
2178 C end of changes by Ana
2179 C dobra zmiana wycofana
2180 & .or. itype(i+2).eq.ntyp1
2181 & .or. itype(i+3).eq.ntyp1) cycle
2182 C Adam: Instructions below will switch off existing interactions
2184 c if(itype(i-1).eq.ntyp1)cycle
2186 c if(i.LT.nres-3)then
2187 c if (itype(i+4).eq.ntyp1) cycle
2192 dx_normi=dc_norm(1,i)
2193 dy_normi=dc_norm(2,i)
2194 dz_normi=dc_norm(3,i)
2195 xmedi=c(1,i)+0.5d0*dxi
2196 ymedi=c(2,i)+0.5d0*dyi
2197 zmedi=c(3,i)+0.5d0*dzi
2198 xmedi=mod(xmedi,boxxsize)
2199 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2200 ymedi=mod(ymedi,boxysize)
2201 if (ymedi.lt.0) ymedi=ymedi+boxysize
2202 zmedi=mod(zmedi,boxzsize)
2203 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2205 call eelecij(i,i+2,ees,evdw1,eel_loc)
2206 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2207 num_cont_hb(i)=num_conti
2209 do i=iturn4_start,iturn4_end
2211 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2212 C changes suggested by Ana to avoid out of bounds
2213 c & .or.((i+5).gt.nres)
2214 c & .or.((i-1).le.0)
2215 C end of changes suggested by Ana
2216 & .or. itype(i+3).eq.ntyp1
2217 & .or. itype(i+4).eq.ntyp1
2218 c & .or. itype(i+5).eq.ntyp1
2219 c & .or. itype(i).eq.ntyp1
2220 c & .or. itype(i-1).eq.ntyp1
2225 dx_normi=dc_norm(1,i)
2226 dy_normi=dc_norm(2,i)
2227 dz_normi=dc_norm(3,i)
2228 xmedi=c(1,i)+0.5d0*dxi
2229 ymedi=c(2,i)+0.5d0*dyi
2230 zmedi=c(3,i)+0.5d0*dzi
2231 C Return atom into box, boxxsize is size of box in x dimension
2233 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2234 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2235 C Condition for being inside the proper box
2236 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2237 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2241 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2242 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2243 C Condition for being inside the proper box
2244 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2245 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2249 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2250 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2251 C Condition for being inside the proper box
2252 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2253 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2256 xmedi=mod(xmedi,boxxsize)
2257 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2258 ymedi=mod(ymedi,boxysize)
2259 if (ymedi.lt.0) ymedi=ymedi+boxysize
2260 zmedi=mod(zmedi,boxzsize)
2261 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2263 num_conti=num_cont_hb(i)
2264 c write(iout,*) "JESTEM W PETLI"
2265 call eelecij(i,i+3,ees,evdw1,eel_loc)
2266 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2267 & call eturn4(i,eello_turn4)
2268 num_cont_hb(i)=num_conti
2270 C Loop over all neighbouring boxes
2275 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2278 do i=iatel_s,iatel_e
2281 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2282 C changes suggested by Ana to avoid out of bounds
2283 c & .or.((i+2).gt.nres)
2284 c & .or.((i-1).le.0)
2285 C end of changes by Ana
2286 c & .or. itype(i+2).eq.ntyp1
2287 c & .or. itype(i-1).eq.ntyp1
2292 dx_normi=dc_norm(1,i)
2293 dy_normi=dc_norm(2,i)
2294 dz_normi=dc_norm(3,i)
2295 xmedi=c(1,i)+0.5d0*dxi
2296 ymedi=c(2,i)+0.5d0*dyi
2297 zmedi=c(3,i)+0.5d0*dzi
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
2304 C xmedi=xmedi+xshift*boxxsize
2305 C ymedi=ymedi+yshift*boxysize
2306 C zmedi=zmedi+zshift*boxzsize
2308 C Return tom into box, boxxsize is size of box in x dimension
2310 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2311 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2312 C Condition for being inside the proper box
2313 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2314 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2318 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2319 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2320 C Condition for being inside the proper box
2321 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2322 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2326 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2327 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2328 cC Condition for being inside the proper box
2329 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2330 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2334 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2335 num_conti=num_cont_hb(i)
2337 do j=ielstart(i),ielend(i)
2339 C write (iout,*) i,j
2341 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2342 C changes suggested by Ana to avoid out of bounds
2343 c & .or.((j+2).gt.nres)
2344 c & .or.((j-1).le.0)
2345 C end of changes by Ana
2346 c & .or.itype(j+2).eq.ntyp1
2347 c & .or.itype(j-1).eq.ntyp1
2349 call eelecij(i,j,ees,evdw1,eel_loc)
2351 num_cont_hb(i)=num_conti
2357 c write (iout,*) "Number of loop steps in EELEC:",ind
2359 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2360 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2362 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2363 ccc eel_loc=eel_loc+eello_turn3
2364 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2367 C-------------------------------------------------------------------------------
2368 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2369 implicit real*8 (a-h,o-z)
2370 include 'DIMENSIONS'
2371 include 'DIMENSIONS.ZSCOPT'
2375 include 'COMMON.CONTROL'
2376 include 'COMMON.IOUNITS'
2377 include 'COMMON.GEO'
2378 include 'COMMON.VAR'
2379 include 'COMMON.LOCAL'
2380 include 'COMMON.CHAIN'
2381 include 'COMMON.DERIV'
2382 include 'COMMON.INTERACT'
2383 include 'COMMON.CONTACTS'
2384 include 'COMMON.TORSION'
2385 include 'COMMON.VECTORS'
2386 include 'COMMON.FFIELD'
2387 include 'COMMON.TIME1'
2388 include 'COMMON.SPLITELE'
2389 include 'COMMON.SHIELD'
2390 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2391 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2392 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2393 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2394 & gmuij2(4),gmuji2(4)
2395 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2396 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2398 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2400 double precision scal_el /1.0d0/
2402 double precision scal_el /0.5d0/
2405 C 13-go grudnia roku pamietnego...
2406 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2407 & 0.0d0,1.0d0,0.0d0,
2408 & 0.0d0,0.0d0,1.0d0/
2409 integer xshift,yshift,zshift
2410 c time00=MPI_Wtime()
2411 cd write (iout,*) "eelecij",i,j
2415 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2416 aaa=app(iteli,itelj)
2417 bbb=bpp(iteli,itelj)
2418 ael6i=ael6(iteli,itelj)
2419 ael3i=ael3(iteli,itelj)
2423 dx_normj=dc_norm(1,j)
2424 dy_normj=dc_norm(2,j)
2425 dz_normj=dc_norm(3,j)
2426 C xj=c(1,j)+0.5D0*dxj-xmedi
2427 C yj=c(2,j)+0.5D0*dyj-ymedi
2428 C zj=c(3,j)+0.5D0*dzj-zmedi
2433 if (xj.lt.0) xj=xj+boxxsize
2435 if (yj.lt.0) yj=yj+boxysize
2437 if (zj.lt.0) zj=zj+boxzsize
2438 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2439 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2447 xj=xj_safe+xshift*boxxsize
2448 yj=yj_safe+yshift*boxysize
2449 zj=zj_safe+zshift*boxzsize
2450 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2451 if(dist_temp.lt.dist_init) then
2461 if (isubchap.eq.1) then
2470 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2472 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2473 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2474 C Condition for being inside the proper box
2475 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2476 c & (xj.lt.((-0.5d0)*boxxsize))) then
2480 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2481 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2482 C Condition for being inside the proper box
2483 c if ((yj.gt.((0.5d0)*boxysize)).or.
2484 c & (yj.lt.((-0.5d0)*boxysize))) then
2488 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2489 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2490 C Condition for being inside the proper box
2491 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2492 c & (zj.lt.((-0.5d0)*boxzsize))) then
2495 C endif !endPBC condintion
2499 rij=xj*xj+yj*yj+zj*zj
2501 sss=sscale(sqrt(rij))
2502 sssgrad=sscagrad(sqrt(rij))
2503 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2504 c & " rlamb",rlamb," sss",sss
2505 c if (sss.gt.0.0d0) then
2511 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2512 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2513 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2514 fac=cosa-3.0D0*cosb*cosg
2516 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2517 if (j.eq.i+2) ev1=scal_el*ev1
2522 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2526 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2527 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2528 if (shield_mode.gt.0) then
2531 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2532 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2541 evdw1=evdw1+evdwij*sss
2542 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2543 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2544 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2545 cd & xmedi,ymedi,zmedi,xj,yj,zj
2547 if (energy_dec) then
2548 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2550 &,iteli,itelj,aaa,evdw1,sss
2551 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2552 &fac_shield(i),fac_shield(j)
2556 C Calculate contributions to the Cartesian gradient.
2559 facvdw=-6*rrmij*(ev1+evdwij)*sss
2560 facel=-3*rrmij*(el1+eesij)
2567 * Radial derivatives. First process both termini of the fragment (i,j)
2573 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2574 & (shield_mode.gt.0)) then
2576 do ilist=1,ishield_list(i)
2577 iresshield=shield_list(ilist,i)
2579 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2581 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2583 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2584 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2585 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2586 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2587 C if (iresshield.gt.i) then
2588 C do ishi=i+1,iresshield-1
2589 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2590 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2594 C do ishi=iresshield,i
2595 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2596 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2602 do ilist=1,ishield_list(j)
2603 iresshield=shield_list(ilist,j)
2605 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2607 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2609 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2610 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2612 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2613 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2614 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2615 C if (iresshield.gt.j) then
2616 C do ishi=j+1,iresshield-1
2617 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2618 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2622 C do ishi=iresshield,j
2623 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2624 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2631 gshieldc(k,i)=gshieldc(k,i)+
2632 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2633 gshieldc(k,j)=gshieldc(k,j)+
2634 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2635 gshieldc(k,i-1)=gshieldc(k,i-1)+
2636 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2637 gshieldc(k,j-1)=gshieldc(k,j-1)+
2638 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2643 c ghalf=0.5D0*ggg(k)
2644 c gelc(k,i)=gelc(k,i)+ghalf
2645 c gelc(k,j)=gelc(k,j)+ghalf
2647 c 9/28/08 AL Gradient compotents will be summed only at the end
2648 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2650 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2651 C & +grad_shield(k,j)*eesij/fac_shield(j)
2652 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2653 C & +grad_shield(k,i)*eesij/fac_shield(i)
2654 C gelc_long(k,i-1)=gelc_long(k,i-1)
2655 C & +grad_shield(k,i)*eesij/fac_shield(i)
2656 C gelc_long(k,j-1)=gelc_long(k,j-1)
2657 C & +grad_shield(k,j)*eesij/fac_shield(j)
2659 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2662 * Loop over residues i+1 thru j-1.
2666 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2669 if (sss.gt.0.0) then
2670 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2671 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2672 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2679 c ghalf=0.5D0*ggg(k)
2680 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2681 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2683 c 9/28/08 AL Gradient compotents will be summed only at the end
2685 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2686 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2689 * Loop over residues i+1 thru j-1.
2693 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2699 facvdw=(ev1+evdwij)*sss
2702 fac=-3*rrmij*(facvdw+facvdw+facel)
2707 * Radial derivatives. First process both termini of the fragment (i,j)
2711 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2713 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2715 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2717 c ghalf=0.5D0*ggg(k)
2718 c gelc(k,i)=gelc(k,i)+ghalf
2719 c gelc(k,j)=gelc(k,j)+ghalf
2721 c 9/28/08 AL Gradient compotents will be summed only at the end
2723 gelc_long(k,j)=gelc(k,j)+ggg(k)
2724 gelc_long(k,i)=gelc(k,i)-ggg(k)
2727 * Loop over residues i+1 thru j-1.
2731 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2734 c 9/28/08 AL Gradient compotents will be summed only at the end
2735 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2736 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2737 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2739 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2740 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2748 ecosa=2.0D0*fac3*fac1+fac4
2751 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2752 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2754 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2755 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2757 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2758 cd & (dcosg(k),k=1,3)
2760 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2761 & fac_shield(i)**2*fac_shield(j)**2
2764 c ghalf=0.5D0*ggg(k)
2765 c gelc(k,i)=gelc(k,i)+ghalf
2766 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2767 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2768 c gelc(k,j)=gelc(k,j)+ghalf
2769 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2770 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2774 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2777 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2780 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2781 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2782 & *fac_shield(i)**2*fac_shield(j)**2
2784 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2785 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2786 & *fac_shield(i)**2*fac_shield(j)**2
2787 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2788 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2790 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2795 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2796 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2797 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2799 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2800 C energy of a peptide unit is assumed in the form of a second-order
2801 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2802 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2803 C are computed for EVERY pair of non-contiguous peptide groups.
2806 if (j.lt.nres-1) then
2818 muij(kkk)=mu(k,i)*mu(l,j)
2819 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2822 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2823 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2824 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2825 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2826 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2827 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2833 write (iout,*) 'EELEC: i',i,' j',j
2834 write (iout,*) 'j',j,' j1',j1,' j2',j2
2835 write(iout,*) 'muij',muij
2836 write (iout,*) "uy",uy(:,i)
2837 write (iout,*) "uz",uz(:,j)
2838 write (iout,*) "erij",erij
2840 ury=scalar(uy(1,i),erij)
2841 urz=scalar(uz(1,i),erij)
2842 vry=scalar(uy(1,j),erij)
2843 vrz=scalar(uz(1,j),erij)
2844 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2845 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2846 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2847 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2848 fac=dsqrt(-ael6i)*r3ij
2853 cd write (iout,'(4i5,4f10.5)')
2854 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2855 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2856 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2857 cd & uy(:,j),uz(:,j)
2858 cd write (iout,'(4f10.5)')
2859 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2860 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2861 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2862 cd write (iout,'(9f10.5/)')
2863 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2864 C Derivatives of the elements of A in virtual-bond vectors
2866 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2868 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2869 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2870 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2871 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2872 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2873 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2874 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2875 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2876 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2877 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2878 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2879 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2881 C Compute radial contributions to the gradient
2899 C Add the contributions coming from er
2902 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2903 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2904 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2905 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2908 C Derivatives in DC(i)
2909 cgrad ghalf1=0.5d0*agg(k,1)
2910 cgrad ghalf2=0.5d0*agg(k,2)
2911 cgrad ghalf3=0.5d0*agg(k,3)
2912 cgrad ghalf4=0.5d0*agg(k,4)
2913 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2914 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2915 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2916 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2917 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2918 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2919 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2920 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2921 C Derivatives in DC(i+1)
2922 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2923 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2924 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2925 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2926 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2927 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2928 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2929 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2930 C Derivatives in DC(j)
2931 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2932 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2933 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2934 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2935 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2936 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2937 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2938 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2939 C Derivatives in DC(j+1) or DC(nres-1)
2940 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2941 & -3.0d0*vryg(k,3)*ury)
2942 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2943 & -3.0d0*vrzg(k,3)*ury)
2944 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2945 & -3.0d0*vryg(k,3)*urz)
2946 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2947 & -3.0d0*vrzg(k,3)*urz)
2948 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2950 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2965 aggi(k,l)=-aggi(k,l)
2966 aggi1(k,l)=-aggi1(k,l)
2967 aggj(k,l)=-aggj(k,l)
2968 aggj1(k,l)=-aggj1(k,l)
2972 if (j.lt.nres-1) then
2978 aggi(k,l)=-aggi(k,l)
2979 aggi1(k,l)=-aggi1(k,l)
2980 aggj(k,l)=-aggj(k,l)
2981 aggj1(k,l)=-aggj1(k,l)
2992 aggi(k,l)=-aggi(k,l)
2993 aggi1(k,l)=-aggi1(k,l)
2994 aggj(k,l)=-aggj(k,l)
2995 aggj1(k,l)=-aggj1(k,l)
3000 IF (wel_loc.gt.0.0d0) THEN
3001 C Contribution to the local-electrostatic energy coming from the i-j pair
3002 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3005 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
3007 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
3008 & " wel_loc",wel_loc
3010 if (shield_mode.eq.0) then
3017 eel_loc_ij=eel_loc_ij
3018 & *fac_shield(i)*fac_shield(j)
3019 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3020 & 'eelloc',i,j,eel_loc_ij
3021 c if (eel_loc_ij.ne.0)
3022 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3023 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3025 eel_loc=eel_loc+eel_loc_ij
3026 C Now derivative over eel_loc
3028 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3029 & (shield_mode.gt.0)) then
3032 do ilist=1,ishield_list(i)
3033 iresshield=shield_list(ilist,i)
3035 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
3038 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3040 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
3041 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3045 do ilist=1,ishield_list(j)
3046 iresshield=shield_list(ilist,j)
3048 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
3051 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3053 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3054 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3061 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3062 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3063 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3064 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3065 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3066 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3067 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3068 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3073 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3074 c & ' eel_loc_ij',eel_loc_ij
3075 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3076 C Calculate patrial derivative for theta angle
3078 geel_loc_ij=(a22*gmuij1(1)
3082 & *fac_shield(i)*fac_shield(j)
3083 c write(iout,*) "derivative over thatai"
3084 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3086 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3087 & geel_loc_ij*wel_loc
3088 c write(iout,*) "derivative over thatai-1"
3089 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3096 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3097 & geel_loc_ij*wel_loc
3098 & *fac_shield(i)*fac_shield(j)
3100 c Derivative over j residue
3101 geel_loc_ji=a22*gmuji1(1)
3105 c write(iout,*) "derivative over thataj"
3106 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3109 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3110 & geel_loc_ji*wel_loc
3111 & *fac_shield(i)*fac_shield(j)
3118 c write(iout,*) "derivative over thataj-1"
3119 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3121 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3122 & geel_loc_ji*wel_loc
3123 & *fac_shield(i)*fac_shield(j)
3125 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3127 C Partial derivatives in virtual-bond dihedral angles gamma
3129 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3130 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3131 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3132 & *fac_shield(i)*fac_shield(j)
3134 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3135 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3136 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3137 & *fac_shield(i)*fac_shield(j)
3138 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3140 ggg(l)=(agg(l,1)*muij(1)+
3141 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3142 & *fac_shield(i)*fac_shield(j)
3143 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3144 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3145 cgrad ghalf=0.5d0*ggg(l)
3146 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3147 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3151 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3154 C Remaining derivatives of eello
3156 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3157 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3158 & *fac_shield(i)*fac_shield(j)
3160 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3161 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3162 & *fac_shield(i)*fac_shield(j)
3164 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3165 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3166 & *fac_shield(i)*fac_shield(j)
3168 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3169 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3170 & *fac_shield(i)*fac_shield(j)
3177 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3178 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3179 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3180 & .and. num_conti.le.maxconts) then
3181 c write (iout,*) i,j," entered corr"
3183 C Calculate the contact function. The ith column of the array JCONT will
3184 C contain the numbers of atoms that make contacts with the atom I (of numbers
3185 C greater than I). The arrays FACONT and GACONT will contain the values of
3186 C the contact function and its derivative.
3187 c r0ij=1.02D0*rpp(iteli,itelj)
3188 c r0ij=1.11D0*rpp(iteli,itelj)
3189 r0ij=2.20D0*rpp(iteli,itelj)
3190 c r0ij=1.55D0*rpp(iteli,itelj)
3191 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3192 if (fcont.gt.0.0D0) then
3193 num_conti=num_conti+1
3194 if (num_conti.gt.maxconts) then
3195 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3196 & ' will skip next contacts for this conf.'
3198 jcont_hb(num_conti,i)=j
3199 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3200 cd & " jcont_hb",jcont_hb(num_conti,i)
3201 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3202 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3203 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3205 d_cont(num_conti,i)=rij
3206 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3207 C --- Electrostatic-interaction matrix ---
3208 a_chuj(1,1,num_conti,i)=a22
3209 a_chuj(1,2,num_conti,i)=a23
3210 a_chuj(2,1,num_conti,i)=a32
3211 a_chuj(2,2,num_conti,i)=a33
3212 C --- Gradient of rij
3215 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3222 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3223 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3224 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3225 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3226 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3232 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3233 C Calculate contact energies
3235 wij=cosa-3.0D0*cosb*cosg
3238 c fac3=dsqrt(-ael6i)/r0ij**3
3239 fac3=dsqrt(-ael6i)*r3ij
3240 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3241 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3242 if (ees0tmp.gt.0) then
3243 ees0pij=dsqrt(ees0tmp)
3247 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3248 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3249 if (ees0tmp.gt.0) then
3250 ees0mij=dsqrt(ees0tmp)
3255 if (shield_mode.eq.0) then
3259 ees0plist(num_conti,i)=j
3260 C fac_shield(i)=0.4d0
3261 C fac_shield(j)=0.6d0
3263 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3264 & *fac_shield(i)*fac_shield(j)
3265 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3266 & *fac_shield(i)*fac_shield(j)
3267 C Diagnostics. Comment out or remove after debugging!
3268 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3269 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3270 c ees0m(num_conti,i)=0.0D0
3272 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3273 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3274 C Angular derivatives of the contact function
3276 ees0pij1=fac3/ees0pij
3277 ees0mij1=fac3/ees0mij
3278 fac3p=-3.0D0*fac3*rrmij
3279 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3280 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3282 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3283 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3284 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3285 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3286 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3287 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3288 ecosap=ecosa1+ecosa2
3289 ecosbp=ecosb1+ecosb2
3290 ecosgp=ecosg1+ecosg2
3291 ecosam=ecosa1-ecosa2
3292 ecosbm=ecosb1-ecosb2
3293 ecosgm=ecosg1-ecosg2
3302 facont_hb(num_conti,i)=fcont
3305 fprimcont=fprimcont/rij
3306 cd facont_hb(num_conti,i)=1.0D0
3307 C Following line is for diagnostics.
3310 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3311 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3314 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3315 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3317 gggp(1)=gggp(1)+ees0pijp*xj
3318 gggp(2)=gggp(2)+ees0pijp*yj
3319 gggp(3)=gggp(3)+ees0pijp*zj
3320 gggm(1)=gggm(1)+ees0mijp*xj
3321 gggm(2)=gggm(2)+ees0mijp*yj
3322 gggm(3)=gggm(3)+ees0mijp*zj
3323 C Derivatives due to the contact function
3324 gacont_hbr(1,num_conti,i)=fprimcont*xj
3325 gacont_hbr(2,num_conti,i)=fprimcont*yj
3326 gacont_hbr(3,num_conti,i)=fprimcont*zj
3329 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3330 c following the change of gradient-summation algorithm.
3332 cgrad ghalfp=0.5D0*gggp(k)
3333 cgrad ghalfm=0.5D0*gggm(k)
3334 gacontp_hb1(k,num_conti,i)=!ghalfp
3335 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3336 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3337 & *fac_shield(i)*fac_shield(j)
3339 gacontp_hb2(k,num_conti,i)=!ghalfp
3340 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3341 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3342 & *fac_shield(i)*fac_shield(j)
3344 gacontp_hb3(k,num_conti,i)=gggp(k)
3345 & *fac_shield(i)*fac_shield(j)
3347 gacontm_hb1(k,num_conti,i)=!ghalfm
3348 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3349 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3350 & *fac_shield(i)*fac_shield(j)
3352 gacontm_hb2(k,num_conti,i)=!ghalfm
3353 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3354 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3355 & *fac_shield(i)*fac_shield(j)
3357 gacontm_hb3(k,num_conti,i)=gggm(k)
3358 & *fac_shield(i)*fac_shield(j)
3361 C Diagnostics. Comment out or remove after debugging!
3363 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3364 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3365 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3366 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3367 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3368 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3374 endif ! num_conti.le.maxconts
3378 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3381 ghalf=0.5d0*agg(l,k)
3382 aggi(l,k)=aggi(l,k)+ghalf
3383 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3384 aggj(l,k)=aggj(l,k)+ghalf
3387 if (j.eq.nres-1 .and. i.lt.j-2) then
3390 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3396 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3399 C-----------------------------------------------------------------------------
3400 subroutine eturn3(i,eello_turn3)
3401 C Third- and fourth-order contributions from turns
3402 implicit real*8 (a-h,o-z)
3403 include 'DIMENSIONS'
3404 include 'DIMENSIONS.ZSCOPT'
3405 include 'COMMON.IOUNITS'
3406 include 'COMMON.GEO'
3407 include 'COMMON.VAR'
3408 include 'COMMON.LOCAL'
3409 include 'COMMON.CHAIN'
3410 include 'COMMON.DERIV'
3411 include 'COMMON.INTERACT'
3412 include 'COMMON.CONTACTS'
3413 include 'COMMON.TORSION'
3414 include 'COMMON.VECTORS'
3415 include 'COMMON.FFIELD'
3416 include 'COMMON.CONTROL'
3417 include 'COMMON.SHIELD'
3419 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3420 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3421 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3422 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3423 & auxgmat2(2,2),auxgmatt2(2,2)
3424 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3425 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3426 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3427 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3430 c write (iout,*) "eturn3",i,j,j1,j2
3435 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3437 C Third-order contributions
3444 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3445 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3446 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3447 c auxalary matices for theta gradient
3448 c auxalary matrix for i+1 and constant i+2
3449 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3450 c auxalary matrix for i+2 and constant i+1
3451 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3452 call transpose2(auxmat(1,1),auxmat1(1,1))
3453 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3454 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3455 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3456 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3457 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3458 if (shield_mode.eq.0) then
3465 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3466 & *fac_shield(i)*fac_shield(j)
3467 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3468 & *fac_shield(i)*fac_shield(j)
3469 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3473 C Derivatives in theta
3474 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3475 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3476 & *fac_shield(i)*fac_shield(j)
3477 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3478 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3479 & *fac_shield(i)*fac_shield(j)
3482 C Derivatives in shield mode
3483 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3484 & (shield_mode.gt.0)) then
3487 do ilist=1,ishield_list(i)
3488 iresshield=shield_list(ilist,i)
3490 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3492 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3494 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3495 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3499 do ilist=1,ishield_list(j)
3500 iresshield=shield_list(ilist,j)
3502 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3504 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3506 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3507 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3514 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3515 & grad_shield(k,i)*eello_t3/fac_shield(i)
3516 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3517 & grad_shield(k,j)*eello_t3/fac_shield(j)
3518 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3519 & grad_shield(k,i)*eello_t3/fac_shield(i)
3520 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3521 & grad_shield(k,j)*eello_t3/fac_shield(j)
3525 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3526 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3527 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3528 cd & ' eello_turn3_num',4*eello_turn3_num
3529 C Derivatives in gamma(i)
3530 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3531 call transpose2(auxmat2(1,1),auxmat3(1,1))
3532 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3533 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3534 & *fac_shield(i)*fac_shield(j)
3535 C Derivatives in gamma(i+1)
3536 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3537 call transpose2(auxmat2(1,1),auxmat3(1,1))
3538 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3539 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3540 & +0.5d0*(pizda(1,1)+pizda(2,2))
3541 & *fac_shield(i)*fac_shield(j)
3542 C Cartesian derivatives
3544 c ghalf1=0.5d0*agg(l,1)
3545 c ghalf2=0.5d0*agg(l,2)
3546 c ghalf3=0.5d0*agg(l,3)
3547 c ghalf4=0.5d0*agg(l,4)
3548 a_temp(1,1)=aggi(l,1)!+ghalf1
3549 a_temp(1,2)=aggi(l,2)!+ghalf2
3550 a_temp(2,1)=aggi(l,3)!+ghalf3
3551 a_temp(2,2)=aggi(l,4)!+ghalf4
3552 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3553 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3554 & +0.5d0*(pizda(1,1)+pizda(2,2))
3555 & *fac_shield(i)*fac_shield(j)
3557 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3558 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3559 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3560 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3561 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3562 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3563 & +0.5d0*(pizda(1,1)+pizda(2,2))
3564 & *fac_shield(i)*fac_shield(j)
3565 a_temp(1,1)=aggj(l,1)!+ghalf1
3566 a_temp(1,2)=aggj(l,2)!+ghalf2
3567 a_temp(2,1)=aggj(l,3)!+ghalf3
3568 a_temp(2,2)=aggj(l,4)!+ghalf4
3569 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3570 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3571 & +0.5d0*(pizda(1,1)+pizda(2,2))
3572 & *fac_shield(i)*fac_shield(j)
3573 a_temp(1,1)=aggj1(l,1)
3574 a_temp(1,2)=aggj1(l,2)
3575 a_temp(2,1)=aggj1(l,3)
3576 a_temp(2,2)=aggj1(l,4)
3577 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3578 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3579 & +0.5d0*(pizda(1,1)+pizda(2,2))
3580 & *fac_shield(i)*fac_shield(j)
3587 C-------------------------------------------------------------------------------
3588 subroutine eturn4(i,eello_turn4)
3589 C Third- and fourth-order contributions from turns
3590 implicit real*8 (a-h,o-z)
3591 include 'DIMENSIONS'
3592 include 'DIMENSIONS.ZSCOPT'
3593 include 'COMMON.IOUNITS'
3594 include 'COMMON.GEO'
3595 include 'COMMON.VAR'
3596 include 'COMMON.LOCAL'
3597 include 'COMMON.CHAIN'
3598 include 'COMMON.DERIV'
3599 include 'COMMON.INTERACT'
3600 include 'COMMON.CONTACTS'
3601 include 'COMMON.TORSION'
3602 include 'COMMON.VECTORS'
3603 include 'COMMON.FFIELD'
3604 include 'COMMON.CONTROL'
3605 include 'COMMON.SHIELD'
3607 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3608 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3609 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3610 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3611 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3612 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3613 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3614 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3615 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3616 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3617 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3620 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3622 C Fourth-order contributions
3630 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3631 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3632 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3633 c write(iout,*)"WCHODZE W PROGRAM"
3638 iti1=itype2loc(itype(i+1))
3639 iti2=itype2loc(itype(i+2))
3640 iti3=itype2loc(itype(i+3))
3641 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3642 call transpose2(EUg(1,1,i+1),e1t(1,1))
3643 call transpose2(Eug(1,1,i+2),e2t(1,1))
3644 call transpose2(Eug(1,1,i+3),e3t(1,1))
3645 C Ematrix derivative in theta
3646 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3647 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3648 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3649 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3650 c eta1 in derivative theta
3651 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3652 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3653 c auxgvec is derivative of Ub2 so i+3 theta
3654 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3655 c auxalary matrix of E i+1
3656 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3659 s1=scalar2(b1(1,i+2),auxvec(1))
3660 c derivative of theta i+2 with constant i+3
3661 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3662 c derivative of theta i+2 with constant i+2
3663 gs32=scalar2(b1(1,i+2),auxgvec(1))
3664 c derivative of E matix in theta of i+1
3665 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3667 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3668 c ea31 in derivative theta
3669 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3670 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3671 c auxilary matrix auxgvec of Ub2 with constant E matirx
3672 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3673 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3674 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3678 s2=scalar2(b1(1,i+1),auxvec(1))
3679 c derivative of theta i+1 with constant i+3
3680 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3681 c derivative of theta i+2 with constant i+1
3682 gs21=scalar2(b1(1,i+1),auxgvec(1))
3683 c derivative of theta i+3 with constant i+1
3684 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3685 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3687 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3688 c two derivatives over diffetent matrices
3689 c gtae3e2 is derivative over i+3
3690 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3691 c ae3gte2 is derivative over i+2
3692 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3693 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3694 c three possible derivative over theta E matices
3696 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3698 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3700 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3701 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3703 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3704 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3705 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3706 if (shield_mode.eq.0) then
3713 eello_turn4=eello_turn4-(s1+s2+s3)
3714 & *fac_shield(i)*fac_shield(j)
3715 eello_t4=-(s1+s2+s3)
3716 & *fac_shield(i)*fac_shield(j)
3717 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3718 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3719 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3720 C Now derivative over shield:
3721 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3722 & (shield_mode.gt.0)) then
3725 do ilist=1,ishield_list(i)
3726 iresshield=shield_list(ilist,i)
3728 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3730 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3732 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3733 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3737 do ilist=1,ishield_list(j)
3738 iresshield=shield_list(ilist,j)
3740 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3742 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3744 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3745 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3752 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3753 & grad_shield(k,i)*eello_t4/fac_shield(i)
3754 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3755 & grad_shield(k,j)*eello_t4/fac_shield(j)
3756 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3757 & grad_shield(k,i)*eello_t4/fac_shield(i)
3758 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3759 & grad_shield(k,j)*eello_t4/fac_shield(j)
3762 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3763 cd & ' eello_turn4_num',8*eello_turn4_num
3765 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3766 & -(gs13+gsE13+gsEE1)*wturn4
3767 & *fac_shield(i)*fac_shield(j)
3768 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3769 & -(gs23+gs21+gsEE2)*wturn4
3770 & *fac_shield(i)*fac_shield(j)
3772 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3773 & -(gs32+gsE31+gsEE3)*wturn4
3774 & *fac_shield(i)*fac_shield(j)
3776 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3779 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3780 & 'eturn4',i,j,-(s1+s2+s3)
3781 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3782 c & ' eello_turn4_num',8*eello_turn4_num
3783 C Derivatives in gamma(i)
3784 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3785 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3786 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3787 s1=scalar2(b1(1,i+2),auxvec(1))
3788 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3789 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3790 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3791 & *fac_shield(i)*fac_shield(j)
3792 C Derivatives in gamma(i+1)
3793 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3794 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3795 s2=scalar2(b1(1,i+1),auxvec(1))
3796 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3797 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3798 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3799 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3800 & *fac_shield(i)*fac_shield(j)
3801 C Derivatives in gamma(i+2)
3802 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3803 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3804 s1=scalar2(b1(1,i+2),auxvec(1))
3805 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3806 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3807 s2=scalar2(b1(1,i+1),auxvec(1))
3808 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3809 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3810 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3811 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3812 & *fac_shield(i)*fac_shield(j)
3814 C Cartesian derivatives
3815 C Derivatives of this turn contributions in DC(i+2)
3816 if (j.lt.nres-1) then
3818 a_temp(1,1)=agg(l,1)
3819 a_temp(1,2)=agg(l,2)
3820 a_temp(2,1)=agg(l,3)
3821 a_temp(2,2)=agg(l,4)
3822 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3823 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3824 s1=scalar2(b1(1,i+2),auxvec(1))
3825 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3826 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3827 s2=scalar2(b1(1,i+1),auxvec(1))
3828 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3829 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3830 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3832 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3833 & *fac_shield(i)*fac_shield(j)
3836 C Remaining derivatives of this turn contribution
3838 a_temp(1,1)=aggi(l,1)
3839 a_temp(1,2)=aggi(l,2)
3840 a_temp(2,1)=aggi(l,3)
3841 a_temp(2,2)=aggi(l,4)
3842 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3843 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3844 s1=scalar2(b1(1,i+2),auxvec(1))
3845 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3846 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3847 s2=scalar2(b1(1,i+1),auxvec(1))
3848 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3849 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3850 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3851 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3852 & *fac_shield(i)*fac_shield(j)
3853 a_temp(1,1)=aggi1(l,1)
3854 a_temp(1,2)=aggi1(l,2)
3855 a_temp(2,1)=aggi1(l,3)
3856 a_temp(2,2)=aggi1(l,4)
3857 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3858 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3859 s1=scalar2(b1(1,i+2),auxvec(1))
3860 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3861 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3862 s2=scalar2(b1(1,i+1),auxvec(1))
3863 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3864 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3865 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3866 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3867 & *fac_shield(i)*fac_shield(j)
3868 a_temp(1,1)=aggj(l,1)
3869 a_temp(1,2)=aggj(l,2)
3870 a_temp(2,1)=aggj(l,3)
3871 a_temp(2,2)=aggj(l,4)
3872 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3873 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3874 s1=scalar2(b1(1,i+2),auxvec(1))
3875 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3876 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3877 s2=scalar2(b1(1,i+1),auxvec(1))
3878 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3879 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3880 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3881 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3882 & *fac_shield(i)*fac_shield(j)
3883 a_temp(1,1)=aggj1(l,1)
3884 a_temp(1,2)=aggj1(l,2)
3885 a_temp(2,1)=aggj1(l,3)
3886 a_temp(2,2)=aggj1(l,4)
3887 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3888 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3889 s1=scalar2(b1(1,i+2),auxvec(1))
3890 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3891 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3892 s2=scalar2(b1(1,i+1),auxvec(1))
3893 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3894 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3895 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3896 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3897 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3898 & *fac_shield(i)*fac_shield(j)
3905 C-----------------------------------------------------------------------------
3906 subroutine vecpr(u,v,w)
3907 implicit real*8(a-h,o-z)
3908 dimension u(3),v(3),w(3)
3909 w(1)=u(2)*v(3)-u(3)*v(2)
3910 w(2)=-u(1)*v(3)+u(3)*v(1)
3911 w(3)=u(1)*v(2)-u(2)*v(1)
3914 C-----------------------------------------------------------------------------
3915 subroutine unormderiv(u,ugrad,unorm,ungrad)
3916 C This subroutine computes the derivatives of a normalized vector u, given
3917 C the derivatives computed without normalization conditions, ugrad. Returns
3920 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3921 double precision vec(3)
3922 double precision scalar
3924 c write (2,*) 'ugrad',ugrad
3927 vec(i)=scalar(ugrad(1,i),u(1))
3929 c write (2,*) 'vec',vec
3932 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3935 c write (2,*) 'ungrad',ungrad
3938 C-----------------------------------------------------------------------------
3939 subroutine escp(evdw2,evdw2_14)
3941 C This subroutine calculates the excluded-volume interaction energy between
3942 C peptide-group centers and side chains and its gradient in virtual-bond and
3943 C side-chain vectors.
3945 implicit real*8 (a-h,o-z)
3946 include 'DIMENSIONS'
3947 include 'DIMENSIONS.ZSCOPT'
3948 include 'COMMON.CONTROL'
3949 include 'COMMON.GEO'
3950 include 'COMMON.VAR'
3951 include 'COMMON.LOCAL'
3952 include 'COMMON.CHAIN'
3953 include 'COMMON.DERIV'
3954 include 'COMMON.INTERACT'
3955 include 'COMMON.FFIELD'
3956 include 'COMMON.IOUNITS'
3960 cd print '(a)','Enter ESCP'
3961 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3962 c & ' scal14',scal14
3963 do i=iatscp_s,iatscp_e
3964 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3966 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3967 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3968 if (iteli.eq.0) goto 1225
3969 xi=0.5D0*(c(1,i)+c(1,i+1))
3970 yi=0.5D0*(c(2,i)+c(2,i+1))
3971 zi=0.5D0*(c(3,i)+c(3,i+1))
3972 C Returning the ith atom to box
3974 if (xi.lt.0) xi=xi+boxxsize
3976 if (yi.lt.0) yi=yi+boxysize
3978 if (zi.lt.0) zi=zi+boxzsize
3979 do iint=1,nscp_gr(i)
3981 do j=iscpstart(i,iint),iscpend(i,iint)
3982 itypj=iabs(itype(j))
3983 if (itypj.eq.ntyp1) cycle
3984 C Uncomment following three lines for SC-p interactions
3988 C Uncomment following three lines for Ca-p interactions
3992 C returning the jth atom to box
3994 if (xj.lt.0) xj=xj+boxxsize
3996 if (yj.lt.0) yj=yj+boxysize
3998 if (zj.lt.0) zj=zj+boxzsize
3999 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4004 C Finding the closest jth atom
4008 xj=xj_safe+xshift*boxxsize
4009 yj=yj_safe+yshift*boxysize
4010 zj=zj_safe+zshift*boxzsize
4011 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4012 if(dist_temp.lt.dist_init) then
4022 if (subchap.eq.1) then
4031 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4032 C sss is scaling function for smoothing the cutoff gradient otherwise
4033 C the gradient would not be continuouse
4034 sss=sscale(1.0d0/(dsqrt(rrij)))
4035 if (sss.le.0.0d0) cycle
4036 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4038 e1=fac*fac*aad(itypj,iteli)
4039 e2=fac*bad(itypj,iteli)
4040 if (iabs(j-i) .le. 2) then
4043 evdw2_14=evdw2_14+(e1+e2)*sss
4046 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4047 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4048 c & bad(itypj,iteli)
4049 evdw2=evdw2+evdwij*sss
4050 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4051 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4056 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4058 fac=-(evdwij+e1)*rrij*sss
4059 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4064 cd write (iout,*) 'j<i'
4065 C Uncomment following three lines for SC-p interactions
4067 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4070 cd write (iout,*) 'j>i'
4073 C Uncomment following line for SC-p interactions
4074 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4078 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4082 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4083 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4086 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4096 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4097 gradx_scp(j,i)=expon*gradx_scp(j,i)
4100 C******************************************************************************
4104 C To save time the factor EXPON has been extracted from ALL components
4105 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4108 C******************************************************************************
4111 C--------------------------------------------------------------------------
4112 subroutine edis(ehpb)
4114 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4116 implicit real*8 (a-h,o-z)
4117 include 'DIMENSIONS'
4118 include 'DIMENSIONS.ZSCOPT'
4119 include 'COMMON.SBRIDGE'
4120 include 'COMMON.CHAIN'
4121 include 'COMMON.DERIV'
4122 include 'COMMON.VAR'
4123 include 'COMMON.INTERACT'
4124 include 'COMMON.CONTROL'
4125 include 'COMMON.IOUNITS'
4126 dimension ggg(3),ggg_peak(3,1000)
4131 c 8/21/18 AL: added explicit restraints on reference coords
4132 c write (iout,*) "restr_on_coord",restr_on_coord
4133 if (restr_on_coord) then
4137 if (itype(i).eq.ntyp1) cycle
4139 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4140 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4142 if (itype(i).ne.10) then
4144 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4145 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4148 if (energy_dec) write (iout,*)
4149 & "i",i," bfac",bfac(i)," ecoor",ecoor
4150 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4155 C write (iout,*) ,"link_end",link_end,constr_dist
4156 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4157 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4158 c & " constr_dist",constr_dist
4159 if (link_end.eq.0.and.link_end_peak.eq.0) return
4160 do i=link_start_peak,link_end_peak
4162 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4163 c & ipeak(1,i),ipeak(2,i)
4164 do ip=ipeak(1,i),ipeak(2,i)
4169 C iii and jjj point to the residues for which the distance is assigned.
4170 c if (ii.gt.nres) then
4177 if (ii.gt.nres) then
4182 if (jj.gt.nres) then
4187 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4188 aux=dexp(-scal_peak*aux)
4189 ehpb_peak=ehpb_peak+aux
4190 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4191 & forcon_peak(ip))*aux/dd
4193 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4195 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4196 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4197 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4199 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4200 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4201 do ip=ipeak(1,i),ipeak(2,i)
4204 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4208 C iii and jjj point to the residues for which the distance is assigned.
4209 if (ii.gt.nres) then
4218 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4223 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4227 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4228 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4232 do i=link_start,link_end
4233 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4234 C CA-CA distance used in regularization of structure.
4237 C iii and jjj point to the residues for which the distance is assigned.
4238 if (ii.gt.nres) then
4243 if (jj.gt.nres) then
4248 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4249 c & dhpb(i),dhpb1(i),forcon(i)
4250 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4251 C distance and angle dependent SS bond potential.
4252 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4253 C & iabs(itype(jjj)).eq.1) then
4254 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4255 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4256 if (.not.dyn_ss .and. i.le.nss) then
4257 C 15/02/13 CC dynamic SSbond - additional check
4258 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4259 & iabs(itype(jjj)).eq.1) then
4260 call ssbond_ene(iii,jjj,eij)
4263 cd write (iout,*) "eij",eij
4264 cd & ' waga=',waga,' fac=',fac
4265 ! else if (ii.gt.nres .and. jj.gt.nres) then
4267 C Calculate the distance between the two points and its difference from the
4270 if (irestr_type(i).eq.11) then
4271 ehpb=ehpb+fordepth(i)!**4.0d0
4272 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4273 fac=fordepth(i)!**4.0d0
4274 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4275 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4276 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4277 & ehpb,irestr_type(i)
4278 else if (irestr_type(i).eq.10) then
4279 c AL 6//19/2018 cross-link restraints
4280 xdis = 0.5d0*(dd/forcon(i))**2
4281 expdis = dexp(-xdis)
4282 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4283 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4284 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4285 c & " wboltzd",wboltzd
4286 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4287 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4288 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4289 & *expdis/(aux*forcon(i)**2)
4290 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4291 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4292 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4293 else if (irestr_type(i).eq.2) then
4294 c Quartic restraints
4295 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4296 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4297 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4298 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4299 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4301 c Quadratic restraints
4303 C Get the force constant corresponding to this distance.
4305 C Calculate the contribution to energy.
4306 ehpb=ehpb+0.5d0*waga*rdis*rdis
4307 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4308 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4309 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4311 C Evaluate gradient.
4315 c Calculate Cartesian gradient
4317 ggg(j)=fac*(c(j,jj)-c(j,ii))
4319 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4320 C If this is a SC-SC distance, we need to calculate the contributions to the
4321 C Cartesian gradient in the SC vectors (ghpbx).
4324 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4329 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4333 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4334 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4340 C--------------------------------------------------------------------------
4341 subroutine ssbond_ene(i,j,eij)
4343 C Calculate the distance and angle dependent SS-bond potential energy
4344 C using a free-energy function derived based on RHF/6-31G** ab initio
4345 C calculations of diethyl disulfide.
4347 C A. Liwo and U. Kozlowska, 11/24/03
4349 implicit real*8 (a-h,o-z)
4350 include 'DIMENSIONS'
4351 include 'DIMENSIONS.ZSCOPT'
4352 include 'COMMON.SBRIDGE'
4353 include 'COMMON.CHAIN'
4354 include 'COMMON.DERIV'
4355 include 'COMMON.LOCAL'
4356 include 'COMMON.INTERACT'
4357 include 'COMMON.VAR'
4358 include 'COMMON.IOUNITS'
4359 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4360 itypi=iabs(itype(i))
4364 dxi=dc_norm(1,nres+i)
4365 dyi=dc_norm(2,nres+i)
4366 dzi=dc_norm(3,nres+i)
4367 dsci_inv=dsc_inv(itypi)
4368 itypj=iabs(itype(j))
4369 dscj_inv=dsc_inv(itypj)
4373 dxj=dc_norm(1,nres+j)
4374 dyj=dc_norm(2,nres+j)
4375 dzj=dc_norm(3,nres+j)
4376 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4381 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4382 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4383 om12=dxi*dxj+dyi*dyj+dzi*dzj
4385 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4386 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4392 deltat12=om2-om1+2.0d0
4394 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4395 & +akct*deltad*deltat12
4396 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4397 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4398 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4399 c & " deltat12",deltat12," eij",eij
4400 ed=2*akcm*deltad+akct*deltat12
4402 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4403 eom1=-2*akth*deltat1-pom1-om2*pom2
4404 eom2= 2*akth*deltat2+pom1-om1*pom2
4407 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4410 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4411 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4412 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4413 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4416 C Calculate the components of the gradient in DC and X
4420 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4425 C--------------------------------------------------------------------------
4426 c MODELLER restraint function
4427 subroutine e_modeller(ehomology_constr)
4428 implicit real*8 (a-h,o-z)
4429 include 'DIMENSIONS'
4430 include 'DIMENSIONS.ZSCOPT'
4431 include 'DIMENSIONS.FREE'
4432 integer nnn, i, j, k, ki, irec, l
4433 integer katy, odleglosci, test7
4434 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
4435 real*8 distance(max_template),distancek(max_template),
4436 & min_odl,godl(max_template),dih_diff(max_template)
4439 c FP - 30/10/2014 Temporary specifications for homology restraints
4441 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
4443 double precision, dimension (maxres) :: guscdiff,usc_diff
4444 double precision, dimension (max_template) ::
4445 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
4448 include 'COMMON.SBRIDGE'
4449 include 'COMMON.CHAIN'
4450 include 'COMMON.GEO'
4451 include 'COMMON.DERIV'
4452 include 'COMMON.LOCAL'
4453 include 'COMMON.INTERACT'
4454 include 'COMMON.VAR'
4455 include 'COMMON.IOUNITS'
4456 include 'COMMON.CONTROL'
4457 include 'COMMON.HOMRESTR'
4458 include 'COMMON.HOMOLOGY'
4459 include 'COMMON.SETUP'
4460 include 'COMMON.NAMES'
4463 distancek(i)=9999999.9
4468 c Pseudo-energy and gradient from homology restraints (MODELLER-like
4470 C AL 5/2/14 - Introduce list of restraints
4471 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
4473 write(iout,*) "------- dist restrs start -------"
4475 do ii = link_start_homo,link_end_homo
4479 c write (iout,*) "dij(",i,j,") =",dij
4481 do k=1,constr_homology
4482 if(.not.l_homo(k,ii)) then
4486 distance(k)=odl(k,ii)-dij
4487 c write (iout,*) "distance(",k,") =",distance(k)
4489 c For Gaussian-type Urestr
4491 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
4492 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
4493 c write (iout,*) "distancek(",k,") =",distancek(k)
4494 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
4496 c For Lorentzian-type Urestr
4498 if (waga_dist.lt.0.0d0) then
4499 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
4500 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
4501 & (distance(k)**2+sigma_odlir(k,ii)**2))
4505 c min_odl=minval(distancek)
4506 do kk=1,constr_homology
4507 if(l_homo(kk,ii)) then
4508 min_odl=distancek(kk)
4512 do kk=1,constr_homology
4513 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
4514 & min_odl=distancek(kk)
4516 c write (iout,* )"min_odl",min_odl
4518 write (iout,*) "ij dij",i,j,dij
4519 write (iout,*) "distance",(distance(k),k=1,constr_homology)
4520 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
4521 write (iout,* )"min_odl",min_odl
4526 if (waga_dist.ge.0.0d0) then
4532 do k=1,constr_homology
4533 c Nie wiem po co to liczycie jeszcze raz!
4534 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
4535 c & (2*(sigma_odl(i,j,k))**2))
4536 if(.not.l_homo(k,ii)) cycle
4537 if (waga_dist.ge.0.0d0) then
4539 c For Gaussian-type Urestr
4541 godl(k)=dexp(-distancek(k)+min_odl)
4542 odleg2=odleg2+godl(k)
4544 c For Lorentzian-type Urestr
4547 odleg2=odleg2+distancek(k)
4550 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
4551 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
4552 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
4553 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
4556 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4557 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4559 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4560 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4562 if (waga_dist.ge.0.0d0) then
4564 c For Gaussian-type Urestr
4566 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
4568 c For Lorentzian-type Urestr
4571 odleg=odleg+odleg2/constr_homology
4575 c write (iout,*) "odleg",odleg ! sum of -ln-s
4578 c For Gaussian-type Urestr
4580 if (waga_dist.ge.0.0d0) sum_godl=odleg2
4582 do k=1,constr_homology
4583 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4584 c & *waga_dist)+min_odl
4585 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
4587 if(.not.l_homo(k,ii)) cycle
4588 if (waga_dist.ge.0.0d0) then
4589 c For Gaussian-type Urestr
4591 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
4593 c For Lorentzian-type Urestr
4596 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
4597 & sigma_odlir(k,ii)**2)**2)
4599 sum_sgodl=sum_sgodl+sgodl
4601 c sgodl2=sgodl2+sgodl
4602 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
4603 c write(iout,*) "constr_homology=",constr_homology
4604 c write(iout,*) i, j, k, "TEST K"
4606 if (waga_dist.ge.0.0d0) then
4608 c For Gaussian-type Urestr
4610 grad_odl3=waga_homology(iset)*waga_dist
4611 & *sum_sgodl/(sum_godl*dij)
4613 c For Lorentzian-type Urestr
4616 c Original grad expr modified by analogy w Gaussian-type Urestr grad
4617 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
4618 grad_odl3=-waga_homology(iset)*waga_dist*
4619 & sum_sgodl/(constr_homology*dij)
4622 c grad_odl3=sum_sgodl/(sum_godl*dij)
4625 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
4626 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
4627 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4629 ccc write(iout,*) godl, sgodl, grad_odl3
4631 c grad_odl=grad_odl+grad_odl3
4634 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
4635 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
4636 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
4637 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4638 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
4639 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
4640 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
4641 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4642 c if (i.eq.25.and.j.eq.27) then
4643 c write(iout,*) "jik",jik,"i",i,"j",j
4644 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
4645 c write(iout,*) "grad_odl3",grad_odl3
4646 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
4647 c write(iout,*) "ggodl",ggodl
4648 c write(iout,*) "ghpbc(",jik,i,")",
4649 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
4654 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
4655 ccc & dLOG(odleg2),"-odleg=", -odleg
4657 enddo ! ii-loop for dist
4659 write(iout,*) "------- dist restrs end -------"
4660 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
4661 c & waga_d.eq.1.0d0) call sum_gradient
4663 c Pseudo-energy and gradient from dihedral-angle restraints from
4664 c homology templates
4665 c write (iout,*) "End of distance loop"
4668 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
4670 write(iout,*) "------- dih restrs start -------"
4671 do i=idihconstr_start_homo,idihconstr_end_homo
4672 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
4675 do i=idihconstr_start_homo,idihconstr_end_homo
4677 c betai=beta(i,i+1,i+2,i+3)
4679 c write (iout,*) "betai =",betai
4680 do k=1,constr_homology
4681 dih_diff(k)=pinorm(dih(k,i)-betai)
4682 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
4683 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
4684 c & -(6.28318-dih_diff(i,k))
4685 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
4686 c & 6.28318+dih_diff(i,k)
4688 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
4690 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
4692 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
4695 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
4698 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
4699 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
4701 write (iout,*) "i",i," betai",betai," kat2",kat2
4702 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
4704 if (kat2.le.1.0d-14) cycle
4705 kat=kat-dLOG(kat2/constr_homology)
4706 c write (iout,*) "kat",kat ! sum of -ln-s
4708 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
4709 ccc & dLOG(kat2), "-kat=", -kat
4712 c ----------------------------------------------------------------------
4714 c ----------------------------------------------------------------------
4718 do k=1,constr_homology
4720 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
4722 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
4724 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
4725 sum_sgdih=sum_sgdih+sgdih
4727 c grad_dih3=sum_sgdih/sum_gdih
4728 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
4730 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
4731 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
4732 ccc & gloc(nphi+i-3,icg)
4733 gloc(i,icg)=gloc(i,icg)+grad_dih3
4735 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
4737 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
4738 ccc & gloc(nphi+i-3,icg)
4740 enddo ! i-loop for dih
4742 write(iout,*) "------- dih restrs end -------"
4745 c Pseudo-energy and gradient for theta angle restraints from
4746 c homology templates
4747 c FP 01/15 - inserted from econstr_local_test.F, loop structure
4751 c For constr_homology reference structures (FP)
4753 c Uconst_back_tot=0.0d0
4756 c Econstr_back legacy
4759 c do i=ithet_start,ithet_end
4762 c do i=loc_start,loc_end
4765 duscdiffx(j,i)=0.0d0
4771 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
4772 c write (iout,*) "waga_theta",waga_theta
4773 if (waga_theta.gt.0.0d0) then
4775 write (iout,*) "usampl",usampl
4776 write(iout,*) "------- theta restrs start -------"
4777 c do i=ithet_start,ithet_end
4778 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
4781 c write (iout,*) "maxres",maxres,"nres",nres
4783 do i=ithet_start,ithet_end
4786 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
4788 c Deviation of theta angles wrt constr_homology ref structures
4790 utheta_i=0.0d0 ! argument of Gaussian for single k
4791 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4792 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
4793 c over residues in a fragment
4794 c write (iout,*) "theta(",i,")=",theta(i)
4795 do k=1,constr_homology
4797 c dtheta_i=theta(j)-thetaref(j,iref)
4798 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
4799 theta_diff(k)=thetatpl(k,i)-theta(i)
4801 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
4802 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
4803 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
4804 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
4805 c Gradient for single Gaussian restraint in subr Econstr_back
4806 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
4809 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
4810 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
4814 c Gradient for multiple Gaussian restraint
4815 sum_gtheta=gutheta_i
4817 do k=1,constr_homology
4818 c New generalized expr for multiple Gaussian from Econstr_back
4819 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
4821 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
4822 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
4825 c Final value of gradient using same var as in Econstr_back
4826 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
4827 & *waga_homology(iset)
4828 c dutheta(i)=sum_sgtheta/sum_gtheta
4830 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
4832 Eval=Eval-dLOG(gutheta_i/constr_homology)
4833 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
4834 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
4835 c Uconst_back=Uconst_back+utheta(i)
4836 enddo ! (i-loop for theta)
4838 write(iout,*) "------- theta restrs end -------"
4842 c Deviation of local SC geometry
4844 c Separation of two i-loops (instructed by AL - 11/3/2014)
4846 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
4847 c write (iout,*) "waga_d",waga_d
4850 write(iout,*) "------- SC restrs start -------"
4851 write (iout,*) "Initial duscdiff,duscdiffx"
4852 do i=loc_start,loc_end
4853 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
4854 & (duscdiffx(jik,i),jik=1,3)
4857 do i=loc_start,loc_end
4858 usc_diff_i=0.0d0 ! argument of Gaussian for single k
4859 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4860 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
4861 c write(iout,*) "xxtab, yytab, zztab"
4862 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
4863 do k=1,constr_homology
4865 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4866 c Original sign inverted for calc of gradients (s. Econstr_back)
4867 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4868 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4869 c write(iout,*) "dxx, dyy, dzz"
4870 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4872 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
4873 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
4874 c uscdiffk(k)=usc_diff(i)
4875 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
4876 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
4877 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
4878 c & xxref(j),yyref(j),zzref(j)
4883 c Generalized expression for multiple Gaussian acc to that for a single
4884 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
4886 c Original implementation
4887 c sum_guscdiff=guscdiff(i)
4889 c sum_sguscdiff=0.0d0
4890 c do k=1,constr_homology
4891 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
4892 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
4893 c sum_sguscdiff=sum_sguscdiff+sguscdiff
4896 c Implementation of new expressions for gradient (Jan. 2015)
4898 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
4900 do k=1,constr_homology
4902 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
4903 c before. Now the drivatives should be correct
4905 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4906 c Original sign inverted for calc of gradients (s. Econstr_back)
4907 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4908 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4910 c New implementation
4912 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
4913 & sigma_d(k,i) ! for the grad wrt r'
4914 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
4917 c New implementation
4918 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
4920 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
4921 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
4922 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
4923 duscdiff(jik,i)=duscdiff(jik,i)+
4924 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
4925 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
4926 duscdiffx(jik,i)=duscdiffx(jik,i)+
4927 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
4928 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
4931 write(iout,*) "jik",jik,"i",i
4932 write(iout,*) "dxx, dyy, dzz"
4933 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4934 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
4935 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
4936 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
4937 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
4938 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
4939 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
4940 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
4941 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
4942 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
4943 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
4944 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
4945 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
4946 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
4947 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
4954 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
4955 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
4957 c write (iout,*) i," uscdiff",uscdiff(i)
4959 c Put together deviations from local geometry
4961 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
4962 c & wfrag_back(3,i,iset)*uscdiff(i)
4963 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
4964 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
4965 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
4966 c Uconst_back=Uconst_back+usc_diff(i)
4968 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
4970 c New implment: multiplied by sum_sguscdiff
4973 enddo ! (i-loop for dscdiff)
4978 write(iout,*) "------- SC restrs end -------"
4979 write (iout,*) "------ After SC loop in e_modeller ------"
4980 do i=loc_start,loc_end
4981 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
4982 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
4984 if (waga_theta.eq.1.0d0) then
4985 write (iout,*) "in e_modeller after SC restr end: dutheta"
4986 do i=ithet_start,ithet_end
4987 write (iout,*) i,dutheta(i)
4990 if (waga_d.eq.1.0d0) then
4991 write (iout,*) "e_modeller after SC loop: duscdiff/x"
4993 write (iout,*) i,(duscdiff(j,i),j=1,3)
4994 write (iout,*) i,(duscdiffx(j,i),j=1,3)
4999 c Total energy from homology restraints
5001 write (iout,*) "odleg",odleg," kat",kat
5002 write (iout,*) "odleg",odleg," kat",kat
5003 write (iout,*) "Eval",Eval," Erot",Erot
5004 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
5005 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
5006 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
5009 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
5011 c ehomology_constr=odleg+kat
5013 c For Lorentzian-type Urestr
5016 if (waga_dist.ge.0.0d0) then
5018 c For Gaussian-type Urestr
5020 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
5021 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
5022 ehomology_constr=waga_dist*odleg+waga_angle*kat+
5023 & waga_theta*Eval+waga_d*Erot
5024 c write (iout,*) "ehomology_constr=",ehomology_constr
5027 c For Lorentzian-type Urestr
5029 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
5030 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
5031 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
5032 & waga_theta*Eval+waga_d*Erot
5033 c write (iout,*) "ehomology_constr=",ehomology_constr
5036 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
5037 & "Eval",waga_theta,eval,
5038 & "Erot",waga_d,Erot
5039 write (iout,*) "ehomology_constr",ehomology_constr
5043 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
5044 747 format(a12,i4,i4,i4,f8.3,f8.3)
5045 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
5046 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
5047 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
5048 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
5050 c-----------------------------------------------------------------------
5051 subroutine ebond(estr)
5053 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5055 implicit real*8 (a-h,o-z)
5056 include 'DIMENSIONS'
5057 include 'DIMENSIONS.ZSCOPT'
5058 include 'COMMON.LOCAL'
5059 include 'COMMON.GEO'
5060 include 'COMMON.INTERACT'
5061 include 'COMMON.DERIV'
5062 include 'COMMON.VAR'
5063 include 'COMMON.CHAIN'
5064 include 'COMMON.IOUNITS'
5065 include 'COMMON.NAMES'
5066 include 'COMMON.FFIELD'
5067 include 'COMMON.CONTROL'
5068 double precision u(3),ud(3)
5071 c write (iout,*) "distchainmax",distchainmax
5073 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5074 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5076 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5077 C & *dc(j,i-1)/vbld(i)
5079 C if (energy_dec) write(iout,*)
5080 C & "estr1",i,vbld(i),distchainmax,
5081 C & gnmr1(vbld(i),-1.0d0,distchainmax)
5083 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5084 diff = vbld(i)-vbldpDUM
5085 C write(iout,*) i,diff
5087 diff = vbld(i)-vbldp0
5088 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
5092 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5095 C write (iout,'(a7,i5,4f7.3)')
5096 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5098 estr=0.5d0*AKP*estr+estr1
5100 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5104 if (iti.ne.10 .and. iti.ne.ntyp1) then
5107 diff=vbld(i+nres)-vbldsc0(1,iti)
5108 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5109 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
5110 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5112 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5116 diff=vbld(i+nres)-vbldsc0(j,iti)
5117 ud(j)=aksc(j,iti)*diff
5118 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5132 uprod2=uprod2*u(k)*u(k)
5136 usumsqder=usumsqder+ud(j)*uprod2
5138 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
5139 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
5140 estr=estr+uprod/usum
5142 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5150 C--------------------------------------------------------------------------
5151 subroutine ebend(etheta,ethetacnstr)
5153 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5154 C angles gamma and its derivatives in consecutive thetas and gammas.
5156 implicit real*8 (a-h,o-z)
5157 include 'DIMENSIONS'
5158 include 'DIMENSIONS.ZSCOPT'
5159 include 'COMMON.LOCAL'
5160 include 'COMMON.GEO'
5161 include 'COMMON.INTERACT'
5162 include 'COMMON.DERIV'
5163 include 'COMMON.VAR'
5164 include 'COMMON.CHAIN'
5165 include 'COMMON.IOUNITS'
5166 include 'COMMON.NAMES'
5167 include 'COMMON.FFIELD'
5168 include 'COMMON.TORCNSTR'
5169 common /calcthet/ term1,term2,termm,diffak,ratak,
5170 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5171 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5172 double precision y(2),z(2)
5174 c time11=dexp(-2*time)
5177 c write (iout,*) "nres",nres
5178 c write (*,'(a,i2)') 'EBEND ICG=',icg
5179 c write (iout,*) ithet_start,ithet_end
5180 do i=ithet_start,ithet_end
5181 C if (itype(i-1).eq.ntyp1) cycle
5183 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5184 & .or.itype(i).eq.ntyp1) cycle
5185 C Zero the energy function and its derivative at 0 or pi.
5186 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5188 ichir1=isign(1,itype(i-2))
5189 ichir2=isign(1,itype(i))
5190 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5191 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5192 if (itype(i-1).eq.10) then
5193 itype1=isign(10,itype(i-2))
5194 ichir11=isign(1,itype(i-2))
5195 ichir12=isign(1,itype(i-2))
5196 itype2=isign(10,itype(i))
5197 ichir21=isign(1,itype(i))
5198 ichir22=isign(1,itype(i))
5205 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5209 c call proc_proc(phii,icrc)
5210 if (icrc.eq.1) phii=150.0
5221 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5225 c call proc_proc(phii1,icrc)
5226 if (icrc.eq.1) phii1=150.0
5238 C Calculate the "mean" value of theta from the part of the distribution
5239 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5240 C In following comments this theta will be referred to as t_c.
5241 thet_pred_mean=0.0d0
5243 athetk=athet(k,it,ichir1,ichir2)
5244 bthetk=bthet(k,it,ichir1,ichir2)
5246 athetk=athet(k,itype1,ichir11,ichir12)
5247 bthetk=bthet(k,itype2,ichir21,ichir22)
5249 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5251 c write (iout,*) "thet_pred_mean",thet_pred_mean
5252 dthett=thet_pred_mean*ssd
5253 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5254 c write (iout,*) "thet_pred_mean",thet_pred_mean
5255 C Derivatives of the "mean" values in gamma1 and gamma2.
5256 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5257 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5258 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5259 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5261 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5262 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5263 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5264 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5266 if (theta(i).gt.pi-delta) then
5267 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5269 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5270 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5271 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5273 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5275 else if (theta(i).lt.delta) then
5276 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5277 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5278 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5280 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5281 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5284 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5287 etheta=etheta+ethetai
5288 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5289 c & 'ebend',i,ethetai,theta(i),itype(i)
5290 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5291 c & rad2deg*phii,rad2deg*phii1,ethetai
5292 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5293 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5294 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5298 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5299 do i=1,ntheta_constr
5300 itheta=itheta_constr(i)
5301 thetiii=theta(itheta)
5302 difi=pinorm(thetiii-theta_constr0(i))
5303 if (difi.gt.theta_drange(i)) then
5304 difi=difi-theta_drange(i)
5305 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5306 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5307 & +for_thet_constr(i)*difi**3
5308 else if (difi.lt.-drange(i)) then
5310 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5311 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5312 & +for_thet_constr(i)*difi**3
5316 C if (energy_dec) then
5317 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5318 C & i,itheta,rad2deg*thetiii,
5319 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5320 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5321 C & gloc(itheta+nphi-2,icg)
5324 C Ufff.... We've done all this!!!
5327 C---------------------------------------------------------------------------
5328 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5330 implicit real*8 (a-h,o-z)
5331 include 'DIMENSIONS'
5332 include 'COMMON.LOCAL'
5333 include 'COMMON.IOUNITS'
5334 common /calcthet/ term1,term2,termm,diffak,ratak,
5335 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5336 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5337 C Calculate the contributions to both Gaussian lobes.
5338 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5339 C The "polynomial part" of the "standard deviation" of this part of
5343 sig=sig*thet_pred_mean+polthet(j,it)
5345 C Derivative of the "interior part" of the "standard deviation of the"
5346 C gamma-dependent Gaussian lobe in t_c.
5347 sigtc=3*polthet(3,it)
5349 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5352 C Set the parameters of both Gaussian lobes of the distribution.
5353 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5354 fac=sig*sig+sigc0(it)
5357 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5358 sigsqtc=-4.0D0*sigcsq*sigtc
5359 c print *,i,sig,sigtc,sigsqtc
5360 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5361 sigtc=-sigtc/(fac*fac)
5362 C Following variable is sigma(t_c)**(-2)
5363 sigcsq=sigcsq*sigcsq
5365 sig0inv=1.0D0/sig0i**2
5366 delthec=thetai-thet_pred_mean
5367 delthe0=thetai-theta0i
5368 term1=-0.5D0*sigcsq*delthec*delthec
5369 term2=-0.5D0*sig0inv*delthe0*delthe0
5370 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5371 C NaNs in taking the logarithm. We extract the largest exponent which is added
5372 C to the energy (this being the log of the distribution) at the end of energy
5373 C term evaluation for this virtual-bond angle.
5374 if (term1.gt.term2) then
5376 term2=dexp(term2-termm)
5380 term1=dexp(term1-termm)
5383 C The ratio between the gamma-independent and gamma-dependent lobes of
5384 C the distribution is a Gaussian function of thet_pred_mean too.
5385 diffak=gthet(2,it)-thet_pred_mean
5386 ratak=diffak/gthet(3,it)**2
5387 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5388 C Let's differentiate it in thet_pred_mean NOW.
5390 C Now put together the distribution terms to make complete distribution.
5391 termexp=term1+ak*term2
5392 termpre=sigc+ak*sig0i
5393 C Contribution of the bending energy from this theta is just the -log of
5394 C the sum of the contributions from the two lobes and the pre-exponential
5395 C factor. Simple enough, isn't it?
5396 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5397 C NOW the derivatives!!!
5398 C 6/6/97 Take into account the deformation.
5399 E_theta=(delthec*sigcsq*term1
5400 & +ak*delthe0*sig0inv*term2)/termexp
5401 E_tc=((sigtc+aktc*sig0i)/termpre
5402 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5403 & aktc*term2)/termexp)
5406 c-----------------------------------------------------------------------------
5407 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5408 implicit real*8 (a-h,o-z)
5409 include 'DIMENSIONS'
5410 include 'COMMON.LOCAL'
5411 include 'COMMON.IOUNITS'
5412 common /calcthet/ term1,term2,termm,diffak,ratak,
5413 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5414 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5415 delthec=thetai-thet_pred_mean
5416 delthe0=thetai-theta0i
5417 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5418 t3 = thetai-thet_pred_mean
5422 t14 = t12+t6*sigsqtc
5424 t21 = thetai-theta0i
5430 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5431 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5432 & *(-t12*t9-ak*sig0inv*t27)
5436 C--------------------------------------------------------------------------
5437 subroutine ebend(etheta)
5439 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5440 C angles gamma and its derivatives in consecutive thetas and gammas.
5441 C ab initio-derived potentials from
5442 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5444 implicit real*8 (a-h,o-z)
5445 include 'DIMENSIONS'
5446 include 'DIMENSIONS.ZSCOPT'
5447 include 'COMMON.LOCAL'
5448 include 'COMMON.GEO'
5449 include 'COMMON.INTERACT'
5450 include 'COMMON.DERIV'
5451 include 'COMMON.VAR'
5452 include 'COMMON.CHAIN'
5453 include 'COMMON.IOUNITS'
5454 include 'COMMON.NAMES'
5455 include 'COMMON.FFIELD'
5456 include 'COMMON.CONTROL'
5457 include 'COMMON.TORCNSTR'
5458 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5459 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5460 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5461 & sinph1ph2(maxdouble,maxdouble)
5462 logical lprn /.false./, lprn1 /.false./
5464 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5465 do i=ithet_start,ithet_end
5467 C if (itype(i-1).eq.ntyp1) cycle
5469 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5470 & .or.itype(i).eq.ntyp1) cycle
5471 if (iabs(itype(i+1)).eq.20) iblock=2
5472 if (iabs(itype(i+1)).ne.20) iblock=1
5476 theti2=0.5d0*theta(i)
5477 ityp2=ithetyp((itype(i-1)))
5479 coskt(k)=dcos(k*theti2)
5480 sinkt(k)=dsin(k*theti2)
5490 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5493 if (phii.ne.phii) phii=150.0
5497 ityp1=ithetyp((itype(i-2)))
5499 cosph1(k)=dcos(k*phii)
5500 sinph1(k)=dsin(k*phii)
5506 ityp1=ithetyp((itype(i-2)))
5512 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5515 if (phii1.ne.phii1) phii1=150.0
5520 ityp3=ithetyp((itype(i)))
5522 cosph2(k)=dcos(k*phii1)
5523 sinph2(k)=dsin(k*phii1)
5528 ityp3=ithetyp((itype(i)))
5534 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5535 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5537 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5540 ccl=cosph1(l)*cosph2(k-l)
5541 ssl=sinph1(l)*sinph2(k-l)
5542 scl=sinph1(l)*cosph2(k-l)
5543 csl=cosph1(l)*sinph2(k-l)
5544 cosph1ph2(l,k)=ccl-ssl
5545 cosph1ph2(k,l)=ccl+ssl
5546 sinph1ph2(l,k)=scl+csl
5547 sinph1ph2(k,l)=scl-csl
5551 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5552 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5553 write (iout,*) "coskt and sinkt"
5555 write (iout,*) k,coskt(k),sinkt(k)
5559 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5560 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5563 & write (iout,*) "k",k,"
5564 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5565 & " ethetai",ethetai
5568 write (iout,*) "cosph and sinph"
5570 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5572 write (iout,*) "cosph1ph2 and sinph2ph2"
5575 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5576 & sinph1ph2(l,k),sinph1ph2(k,l)
5579 write(iout,*) "ethetai",ethetai
5583 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5584 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5585 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5586 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5587 ethetai=ethetai+sinkt(m)*aux
5588 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5589 dephii=dephii+k*sinkt(m)*(
5590 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5591 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5592 dephii1=dephii1+k*sinkt(m)*(
5593 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5594 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5596 & write (iout,*) "m",m," k",k," bbthet",
5597 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5598 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5599 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5600 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5604 & write(iout,*) "ethetai",ethetai
5608 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5609 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5610 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5611 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5612 ethetai=ethetai+sinkt(m)*aux
5613 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5614 dephii=dephii+l*sinkt(m)*(
5615 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5616 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5617 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5618 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5619 dephii1=dephii1+(k-l)*sinkt(m)*(
5620 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5621 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5622 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5623 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5625 write (iout,*) "m",m," k",k," l",l," ffthet",
5626 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5627 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5628 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5629 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5630 & " ethetai",ethetai
5631 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5632 & cosph1ph2(k,l)*sinkt(m),
5633 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5639 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5640 & i,theta(i)*rad2deg,phii*rad2deg,
5641 & phii1*rad2deg,ethetai
5642 etheta=etheta+ethetai
5643 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5644 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5645 c gloc(nphi+i-2,icg)=wang*dethetai
5646 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5652 c-----------------------------------------------------------------------------
5653 subroutine esc(escloc)
5654 C Calculate the local energy of a side chain and its derivatives in the
5655 C corresponding virtual-bond valence angles THETA and the spherical angles
5657 implicit real*8 (a-h,o-z)
5658 include 'DIMENSIONS'
5659 include 'DIMENSIONS.ZSCOPT'
5660 include 'COMMON.GEO'
5661 include 'COMMON.LOCAL'
5662 include 'COMMON.VAR'
5663 include 'COMMON.INTERACT'
5664 include 'COMMON.DERIV'
5665 include 'COMMON.CHAIN'
5666 include 'COMMON.IOUNITS'
5667 include 'COMMON.NAMES'
5668 include 'COMMON.FFIELD'
5669 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5670 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5671 common /sccalc/ time11,time12,time112,theti,it,nlobit
5674 C write (iout,*) 'ESC'
5675 do i=loc_start,loc_end
5677 if (it.eq.ntyp1) cycle
5678 if (it.eq.10) goto 1
5679 nlobit=nlob(iabs(it))
5680 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5681 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5682 theti=theta(i+1)-pipol
5686 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5688 if (x(2).gt.pi-delta) then
5692 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5694 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5695 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5697 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5698 & ddersc0(1),dersc(1))
5699 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5700 & ddersc0(3),dersc(3))
5702 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5704 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5705 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5706 & dersc0(2),esclocbi,dersc02)
5707 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5709 call splinthet(x(2),0.5d0*delta,ss,ssd)
5714 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5716 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5717 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5719 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5721 c write (iout,*) escloci
5722 else if (x(2).lt.delta) then
5726 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5728 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5729 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5731 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5732 & ddersc0(1),dersc(1))
5733 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5734 & ddersc0(3),dersc(3))
5736 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5738 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5739 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5740 & dersc0(2),esclocbi,dersc02)
5741 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5746 call splinthet(x(2),0.5d0*delta,ss,ssd)
5748 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5750 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5751 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5753 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5754 C write (iout,*) 'i=',i, escloci
5756 call enesc(x,escloci,dersc,ddummy,.false.)
5759 escloc=escloc+escloci
5760 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5761 write (iout,'(a6,i5,0pf7.3)')
5762 & 'escloc',i,escloci
5764 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5766 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5767 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5772 C---------------------------------------------------------------------------
5773 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5774 implicit real*8 (a-h,o-z)
5775 include 'DIMENSIONS'
5776 include 'COMMON.GEO'
5777 include 'COMMON.LOCAL'
5778 include 'COMMON.IOUNITS'
5779 common /sccalc/ time11,time12,time112,theti,it,nlobit
5780 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5781 double precision contr(maxlob,-1:1)
5783 c write (iout,*) 'it=',it,' nlobit=',nlobit
5787 if (mixed) ddersc(j)=0.0d0
5791 C Because of periodicity of the dependence of the SC energy in omega we have
5792 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5793 C To avoid underflows, first compute & store the exponents.
5801 z(k)=x(k)-censc(k,j,it)
5806 Axk=Axk+gaussc(l,k,j,it)*z(l)
5812 expfac=expfac+Ax(k,j,iii)*z(k)
5820 C As in the case of ebend, we want to avoid underflows in exponentiation and
5821 C subsequent NaNs and INFs in energy calculation.
5822 C Find the largest exponent
5826 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5830 cd print *,'it=',it,' emin=',emin
5832 C Compute the contribution to SC energy and derivatives
5836 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5837 cd print *,'j=',j,' expfac=',expfac
5838 escloc_i=escloc_i+expfac
5840 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5844 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5845 & +gaussc(k,2,j,it))*expfac
5852 dersc(1)=dersc(1)/cos(theti)**2
5853 ddersc(1)=ddersc(1)/cos(theti)**2
5856 escloci=-(dlog(escloc_i)-emin)
5858 dersc(j)=dersc(j)/escloc_i
5862 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5867 C------------------------------------------------------------------------------
5868 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5869 implicit real*8 (a-h,o-z)
5870 include 'DIMENSIONS'
5871 include 'COMMON.GEO'
5872 include 'COMMON.LOCAL'
5873 include 'COMMON.IOUNITS'
5874 common /sccalc/ time11,time12,time112,theti,it,nlobit
5875 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5876 double precision contr(maxlob)
5887 z(k)=x(k)-censc(k,j,it)
5893 Axk=Axk+gaussc(l,k,j,it)*z(l)
5899 expfac=expfac+Ax(k,j)*z(k)
5904 C As in the case of ebend, we want to avoid underflows in exponentiation and
5905 C subsequent NaNs and INFs in energy calculation.
5906 C Find the largest exponent
5909 if (emin.gt.contr(j)) emin=contr(j)
5913 C Compute the contribution to SC energy and derivatives
5917 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5918 escloc_i=escloc_i+expfac
5920 dersc(k)=dersc(k)+Ax(k,j)*expfac
5922 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5923 & +gaussc(1,2,j,it))*expfac
5927 dersc(1)=dersc(1)/cos(theti)**2
5928 dersc12=dersc12/cos(theti)**2
5929 escloci=-(dlog(escloc_i)-emin)
5931 dersc(j)=dersc(j)/escloc_i
5933 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5937 c----------------------------------------------------------------------------------
5938 subroutine esc(escloc)
5939 C Calculate the local energy of a side chain and its derivatives in the
5940 C corresponding virtual-bond valence angles THETA and the spherical angles
5941 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5942 C added by Urszula Kozlowska. 07/11/2007
5944 implicit real*8 (a-h,o-z)
5945 include 'DIMENSIONS'
5946 include 'DIMENSIONS.ZSCOPT'
5947 include 'COMMON.GEO'
5948 include 'COMMON.LOCAL'
5949 include 'COMMON.VAR'
5950 include 'COMMON.SCROT'
5951 include 'COMMON.INTERACT'
5952 include 'COMMON.DERIV'
5953 include 'COMMON.CHAIN'
5954 include 'COMMON.IOUNITS'
5955 include 'COMMON.NAMES'
5956 include 'COMMON.FFIELD'
5957 include 'COMMON.CONTROL'
5958 include 'COMMON.VECTORS'
5959 double precision x_prime(3),y_prime(3),z_prime(3)
5960 & , sumene,dsc_i,dp2_i,x(65),
5961 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5962 & de_dxx,de_dyy,de_dzz,de_dt
5963 double precision s1_t,s1_6_t,s2_t,s2_6_t
5965 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5966 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5967 & dt_dCi(3),dt_dCi1(3)
5968 common /sccalc/ time11,time12,time112,theti,it,nlobit
5971 do i=loc_start,loc_end
5972 if (itype(i).eq.ntyp1) cycle
5973 costtab(i+1) =dcos(theta(i+1))
5974 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5975 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5976 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5977 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5978 cosfac=dsqrt(cosfac2)
5979 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5980 sinfac=dsqrt(sinfac2)
5982 if (it.eq.10) goto 1
5984 C Compute the axes of tghe local cartesian coordinates system; store in
5985 c x_prime, y_prime and z_prime
5992 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5993 C & dc_norm(3,i+nres)
5995 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5996 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5999 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6002 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6003 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6004 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6005 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6006 c & " xy",scalar(x_prime(1),y_prime(1)),
6007 c & " xz",scalar(x_prime(1),z_prime(1)),
6008 c & " yy",scalar(y_prime(1),y_prime(1)),
6009 c & " yz",scalar(y_prime(1),z_prime(1)),
6010 c & " zz",scalar(z_prime(1),z_prime(1))
6012 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6013 C to local coordinate system. Store in xx, yy, zz.
6019 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6020 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6021 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6028 C Compute the energy of the ith side cbain
6030 c write (2,*) "xx",xx," yy",yy," zz",zz
6033 x(j) = sc_parmin(j,it)
6036 Cc diagnostics - remove later
6038 yy1 = dsin(alph(2))*dcos(omeg(2))
6039 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
6040 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6041 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6043 C," --- ", xx_w,yy_w,zz_w
6046 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6047 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6049 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6050 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6052 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6053 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6054 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6055 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6056 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6058 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6059 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6060 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6061 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6062 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6064 dsc_i = 0.743d0+x(61)
6066 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6067 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6068 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6069 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6070 s1=(1+x(63))/(0.1d0 + dscp1)
6071 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6072 s2=(1+x(65))/(0.1d0 + dscp2)
6073 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6074 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6075 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6076 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6078 c & dscp1,dscp2,sumene
6079 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6080 escloc = escloc + sumene
6081 c write (2,*) "escloc",escloc
6082 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
6084 if (.not. calc_grad) goto 1
6087 C This section to check the numerical derivatives of the energy of ith side
6088 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6089 C #define DEBUG in the code to turn it on.
6091 write (2,*) "sumene =",sumene
6095 write (2,*) xx,yy,zz
6096 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6097 de_dxx_num=(sumenep-sumene)/aincr
6099 write (2,*) "xx+ sumene from enesc=",sumenep
6102 write (2,*) xx,yy,zz
6103 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6104 de_dyy_num=(sumenep-sumene)/aincr
6106 write (2,*) "yy+ sumene from enesc=",sumenep
6109 write (2,*) xx,yy,zz
6110 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6111 de_dzz_num=(sumenep-sumene)/aincr
6113 write (2,*) "zz+ sumene from enesc=",sumenep
6114 costsave=cost2tab(i+1)
6115 sintsave=sint2tab(i+1)
6116 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6117 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6118 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6119 de_dt_num=(sumenep-sumene)/aincr
6120 write (2,*) " t+ sumene from enesc=",sumenep
6121 cost2tab(i+1)=costsave
6122 sint2tab(i+1)=sintsave
6123 C End of diagnostics section.
6126 C Compute the gradient of esc
6128 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6129 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6130 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6131 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6132 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6133 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6134 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6135 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6136 pom1=(sumene3*sint2tab(i+1)+sumene1)
6137 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6138 pom2=(sumene4*cost2tab(i+1)+sumene2)
6139 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6140 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6141 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6142 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6144 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6145 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6146 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6148 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6149 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6150 & +(pom1+pom2)*pom_dx
6152 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
6155 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6156 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6157 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6159 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6160 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6161 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6162 & +x(59)*zz**2 +x(60)*xx*zz
6163 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6164 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6165 & +(pom1-pom2)*pom_dy
6167 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
6170 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6171 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6172 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6173 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6174 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6175 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6176 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6177 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6179 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
6182 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6183 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6184 & +pom1*pom_dt1+pom2*pom_dt2
6186 write(2,*), "de_dt = ", de_dt,de_dt_num
6190 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6191 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6192 cosfac2xx=cosfac2*xx
6193 sinfac2yy=sinfac2*yy
6195 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6197 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6199 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6200 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6201 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6202 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6203 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6204 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6205 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6206 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6207 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6208 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6212 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6213 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6214 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6215 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6218 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6219 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6220 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
6222 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6223 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6227 dXX_Ctab(k,i)=dXX_Ci(k)
6228 dXX_C1tab(k,i)=dXX_Ci1(k)
6229 dYY_Ctab(k,i)=dYY_Ci(k)
6230 dYY_C1tab(k,i)=dYY_Ci1(k)
6231 dZZ_Ctab(k,i)=dZZ_Ci(k)
6232 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6233 dXX_XYZtab(k,i)=dXX_XYZ(k)
6234 dYY_XYZtab(k,i)=dYY_XYZ(k)
6235 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6239 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6240 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6241 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6242 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6243 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6245 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6246 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6247 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6248 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6249 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6250 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6251 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6252 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6254 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6255 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6257 C to check gradient call subroutine check_grad
6264 c------------------------------------------------------------------------------
6265 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6267 C This procedure calculates two-body contact function g(rij) and its derivative:
6270 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6273 C where x=(rij-r0ij)/delta
6275 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6278 double precision rij,r0ij,eps0ij,fcont,fprimcont
6279 double precision x,x2,x4,delta
6283 if (x.lt.-1.0D0) then
6286 else if (x.le.1.0D0) then
6289 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6290 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6297 c------------------------------------------------------------------------------
6298 subroutine splinthet(theti,delta,ss,ssder)
6299 implicit real*8 (a-h,o-z)
6300 include 'DIMENSIONS'
6301 include 'DIMENSIONS.ZSCOPT'
6302 include 'COMMON.VAR'
6303 include 'COMMON.GEO'
6306 if (theti.gt.pipol) then
6307 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6309 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6314 c------------------------------------------------------------------------------
6315 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6317 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6318 double precision ksi,ksi2,ksi3,a1,a2,a3
6319 a1=fprim0*delta/(f1-f0)
6325 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6326 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6329 c------------------------------------------------------------------------------
6330 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6332 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6333 double precision ksi,ksi2,ksi3,a1,a2,a3
6338 a2=3*(f1x-f0x)-2*fprim0x*delta
6339 a3=fprim0x*delta-2*(f1x-f0x)
6340 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6343 C-----------------------------------------------------------------------------
6345 C-----------------------------------------------------------------------------
6346 subroutine etor(etors,fact)
6347 implicit real*8 (a-h,o-z)
6348 include 'DIMENSIONS'
6349 include 'DIMENSIONS.ZSCOPT'
6350 include 'COMMON.VAR'
6351 include 'COMMON.GEO'
6352 include 'COMMON.LOCAL'
6353 include 'COMMON.TORSION'
6354 include 'COMMON.INTERACT'
6355 include 'COMMON.DERIV'
6356 include 'COMMON.CHAIN'
6357 include 'COMMON.NAMES'
6358 include 'COMMON.IOUNITS'
6359 include 'COMMON.FFIELD'
6360 include 'COMMON.TORCNSTR'
6362 C Set lprn=.true. for debugging
6366 do i=iphi_start,iphi_end
6367 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6368 & .or. itype(i).eq.ntyp1) cycle
6369 itori=itortyp(itype(i-2))
6370 itori1=itortyp(itype(i-1))
6373 C Proline-Proline pair is a special case...
6374 if (itori.eq.3 .and. itori1.eq.3) then
6375 if (phii.gt.-dwapi3) then
6377 fac=1.0D0/(1.0D0-cosphi)
6378 etorsi=v1(1,3,3)*fac
6379 etorsi=etorsi+etorsi
6380 etors=etors+etorsi-v1(1,3,3)
6381 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6384 v1ij=v1(j+1,itori,itori1)
6385 v2ij=v2(j+1,itori,itori1)
6388 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6389 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6393 v1ij=v1(j,itori,itori1)
6394 v2ij=v2(j,itori,itori1)
6397 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6398 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6402 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6403 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6404 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6405 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6406 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6410 c------------------------------------------------------------------------------
6412 subroutine etor(etors,fact)
6413 implicit real*8 (a-h,o-z)
6414 include 'DIMENSIONS'
6415 include 'DIMENSIONS.ZSCOPT'
6416 include 'COMMON.VAR'
6417 include 'COMMON.GEO'
6418 include 'COMMON.LOCAL'
6419 include 'COMMON.TORSION'
6420 include 'COMMON.INTERACT'
6421 include 'COMMON.DERIV'
6422 include 'COMMON.CHAIN'
6423 include 'COMMON.NAMES'
6424 include 'COMMON.IOUNITS'
6425 include 'COMMON.FFIELD'
6426 include 'COMMON.TORCNSTR'
6428 C Set lprn=.true. for debugging
6432 do i=iphi_start,iphi_end
6434 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6435 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6436 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6437 C & .or. itype(i).eq.ntyp1) cycle
6438 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6439 if (iabs(itype(i)).eq.20) then
6444 itori=itortyp(itype(i-2))
6445 itori1=itortyp(itype(i-1))
6448 C Regular cosine and sine terms
6449 do j=1,nterm(itori,itori1,iblock)
6450 v1ij=v1(j,itori,itori1,iblock)
6451 v2ij=v2(j,itori,itori1,iblock)
6454 etors=etors+v1ij*cosphi+v2ij*sinphi
6455 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6459 C E = SUM ----------------------------------- - v1
6460 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6462 cosphi=dcos(0.5d0*phii)
6463 sinphi=dsin(0.5d0*phii)
6464 do j=1,nlor(itori,itori1,iblock)
6465 vl1ij=vlor1(j,itori,itori1)
6466 vl2ij=vlor2(j,itori,itori1)
6467 vl3ij=vlor3(j,itori,itori1)
6468 pom=vl2ij*cosphi+vl3ij*sinphi
6469 pom1=1.0d0/(pom*pom+1.0d0)
6470 etors=etors+vl1ij*pom1
6471 c if (energy_dec) etors_ii=etors_ii+
6474 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6476 C Subtract the constant term
6477 etors=etors-v0(itori,itori1,iblock)
6479 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6480 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6481 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
6482 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6483 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6488 c----------------------------------------------------------------------------
6489 subroutine etor_d(etors_d,fact2)
6490 C 6/23/01 Compute double torsional energy
6491 implicit real*8 (a-h,o-z)
6492 include 'DIMENSIONS'
6493 include 'DIMENSIONS.ZSCOPT'
6494 include 'COMMON.VAR'
6495 include 'COMMON.GEO'
6496 include 'COMMON.LOCAL'
6497 include 'COMMON.TORSION'
6498 include 'COMMON.INTERACT'
6499 include 'COMMON.DERIV'
6500 include 'COMMON.CHAIN'
6501 include 'COMMON.NAMES'
6502 include 'COMMON.IOUNITS'
6503 include 'COMMON.FFIELD'
6504 include 'COMMON.TORCNSTR'
6506 C Set lprn=.true. for debugging
6510 do i=iphi_start,iphi_end-1
6512 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6513 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
6514 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6515 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6516 & (itype(i+1).eq.ntyp1)) cycle
6517 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6519 itori=itortyp(itype(i-2))
6520 itori1=itortyp(itype(i-1))
6521 itori2=itortyp(itype(i))
6527 if (iabs(itype(i+1)).eq.20) iblock=2
6528 C Regular cosine and sine terms
6529 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6530 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6531 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6532 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6533 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6534 cosphi1=dcos(j*phii)
6535 sinphi1=dsin(j*phii)
6536 cosphi2=dcos(j*phii1)
6537 sinphi2=dsin(j*phii1)
6538 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6539 & v2cij*cosphi2+v2sij*sinphi2
6540 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6541 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6543 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6545 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6546 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6547 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6548 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6549 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6550 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6551 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6552 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6553 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6554 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6555 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6556 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6557 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6558 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6561 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6562 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6568 c---------------------------------------------------------------------------
6569 C The rigorous attempt to derive energy function
6570 subroutine etor_kcc(etors,fact)
6571 implicit real*8 (a-h,o-z)
6572 include 'DIMENSIONS'
6573 include 'DIMENSIONS.ZSCOPT'
6574 include 'COMMON.VAR'
6575 include 'COMMON.GEO'
6576 include 'COMMON.LOCAL'
6577 include 'COMMON.TORSION'
6578 include 'COMMON.INTERACT'
6579 include 'COMMON.DERIV'
6580 include 'COMMON.CHAIN'
6581 include 'COMMON.NAMES'
6582 include 'COMMON.IOUNITS'
6583 include 'COMMON.FFIELD'
6584 include 'COMMON.TORCNSTR'
6585 include 'COMMON.CONTROL'
6586 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
6588 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
6589 C Set lprn=.true. for debugging
6592 C print *,"wchodze kcc"
6593 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
6595 do i=iphi_start,iphi_end
6596 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6597 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6598 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6599 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6600 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6601 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6602 itori=itortyp(itype(i-2))
6603 itori1=itortyp(itype(i-1))
6608 C to avoid multiple devision by 2
6609 c theti22=0.5d0*theta(i)
6610 C theta 12 is the theta_1 /2
6611 C theta 22 is theta_2 /2
6612 c theti12=0.5d0*theta(i-1)
6613 C and appropriate sinus function
6614 sinthet1=dsin(theta(i-1))
6615 sinthet2=dsin(theta(i))
6616 costhet1=dcos(theta(i-1))
6617 costhet2=dcos(theta(i))
6618 C to speed up lets store its mutliplication
6619 sint1t2=sinthet2*sinthet1
6621 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
6622 C +d_n*sin(n*gamma)) *
6623 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
6624 C we have two sum 1) Non-Chebyshev which is with n and gamma
6625 nval=nterm_kcc_Tb(itori,itori1)
6631 c1(j)=c1(j-1)*costhet1
6632 c2(j)=c2(j-1)*costhet2
6635 do j=1,nterm_kcc(itori,itori1)
6639 sint1t2n=sint1t2n*sint1t2
6645 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6646 gradvalct1=gradvalct1+
6647 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6648 gradvalct2=gradvalct2+
6649 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6652 gradvalct1=-gradvalct1*sinthet1
6653 gradvalct2=-gradvalct2*sinthet2
6659 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6660 gradvalst1=gradvalst1+
6661 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6662 gradvalst2=gradvalst2+
6663 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6666 gradvalst1=-gradvalst1*sinthet1
6667 gradvalst2=-gradvalst2*sinthet2
6668 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6669 C glocig is the gradient local i site in gamma
6670 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6671 C now gradient over theta_1
6672 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6673 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6674 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6675 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6678 C derivative over gamma
6679 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6680 C derivative over theta1
6681 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6682 C now derivative over theta2
6683 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6685 write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6686 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6687 write (iout,*) "c1",(c1(k),k=0,nval),
6688 & " c2",(c2(k),k=0,nval)
6689 write (iout,*) "sumvalc",sumvalc," sumvals",sumvals
6694 c---------------------------------------------------------------------------------------------
6695 subroutine etor_constr(edihcnstr)
6696 implicit real*8 (a-h,o-z)
6697 include 'DIMENSIONS'
6698 include 'DIMENSIONS.ZSCOPT'
6699 include 'COMMON.VAR'
6700 include 'COMMON.GEO'
6701 include 'COMMON.LOCAL'
6702 include 'COMMON.TORSION'
6703 include 'COMMON.INTERACT'
6704 include 'COMMON.DERIV'
6705 include 'COMMON.CHAIN'
6706 include 'COMMON.NAMES'
6707 include 'COMMON.IOUNITS'
6708 include 'COMMON.FFIELD'
6709 include 'COMMON.TORCNSTR'
6710 include 'COMMON.CONTROL'
6711 ! 6/20/98 - dihedral angle constraints
6713 c do i=1,ndih_constr
6714 c write (iout,*) "idihconstr_start",idihconstr_start,
6715 c & " idihconstr_end",idihconstr_end
6717 if (raw_psipred) then
6718 do i=idihconstr_start,idihconstr_end
6719 itori=idih_constr(i)
6721 gaudih_i=vpsipred(1,i)
6725 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6726 dexpcos_i=dexp(-cos_i*cos_i)
6727 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6728 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6729 & *cos_i*dexpcos_i/s**2
6731 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6732 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6734 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6735 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6736 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6737 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6738 & -wdihc*dlog(gaudih_i)
6742 do i=idihconstr_start,idihconstr_end
6743 itori=idih_constr(i)
6745 difi=pinorm(phii-phi0(i))
6746 if (difi.gt.drange(i)) then
6748 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6749 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6750 else if (difi.lt.-drange(i)) then
6752 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6753 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6761 c write (iout,*) "ETOR_CONSTR",edihcnstr
6764 c----------------------------------------------------------------------------
6765 C The rigorous attempt to derive energy function
6766 subroutine ebend_kcc(etheta)
6768 implicit real*8 (a-h,o-z)
6769 include 'DIMENSIONS'
6770 include 'DIMENSIONS.ZSCOPT'
6771 include 'COMMON.VAR'
6772 include 'COMMON.GEO'
6773 include 'COMMON.LOCAL'
6774 include 'COMMON.TORSION'
6775 include 'COMMON.INTERACT'
6776 include 'COMMON.DERIV'
6777 include 'COMMON.CHAIN'
6778 include 'COMMON.NAMES'
6779 include 'COMMON.IOUNITS'
6780 include 'COMMON.FFIELD'
6781 include 'COMMON.TORCNSTR'
6782 include 'COMMON.CONTROL'
6784 double precision thybt1(maxang_kcc)
6785 C Set lprn=.true. for debugging
6788 C print *,"wchodze kcc"
6789 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6791 do i=ithet_start,ithet_end
6792 c print *,i,itype(i-1),itype(i),itype(i-2)
6793 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6794 & .or.itype(i).eq.ntyp1) cycle
6795 iti=iabs(itortyp(itype(i-1)))
6796 sinthet=dsin(theta(i))
6797 costhet=dcos(theta(i))
6798 do j=1,nbend_kcc_Tb(iti)
6799 thybt1(j)=v1bend_chyb(j,iti)
6801 sumth1thyb=v1bend_chyb(0,iti)+
6802 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6803 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6805 ihelp=nbend_kcc_Tb(iti)-1
6806 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6807 etheta=etheta+sumth1thyb
6808 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6809 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6813 c-------------------------------------------------------------------------------------
6814 subroutine etheta_constr(ethetacnstr)
6816 implicit real*8 (a-h,o-z)
6817 include 'DIMENSIONS'
6818 include 'DIMENSIONS.ZSCOPT'
6819 include 'COMMON.VAR'
6820 include 'COMMON.GEO'
6821 include 'COMMON.LOCAL'
6822 include 'COMMON.TORSION'
6823 include 'COMMON.INTERACT'
6824 include 'COMMON.DERIV'
6825 include 'COMMON.CHAIN'
6826 include 'COMMON.NAMES'
6827 include 'COMMON.IOUNITS'
6828 include 'COMMON.FFIELD'
6829 include 'COMMON.TORCNSTR'
6830 include 'COMMON.CONTROL'
6832 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6833 do i=ithetaconstr_start,ithetaconstr_end
6834 itheta=itheta_constr(i)
6835 thetiii=theta(itheta)
6836 difi=pinorm(thetiii-theta_constr0(i))
6837 if (difi.gt.theta_drange(i)) then
6838 difi=difi-theta_drange(i)
6839 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6840 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6841 & +for_thet_constr(i)*difi**3
6842 else if (difi.lt.-drange(i)) then
6844 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6845 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6846 & +for_thet_constr(i)*difi**3
6850 if (energy_dec) then
6851 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6852 & i,itheta,rad2deg*thetiii,
6853 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6854 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6855 & gloc(itheta+nphi-2,icg)
6860 c------------------------------------------------------------------------------
6861 c------------------------------------------------------------------------------
6862 subroutine eback_sc_corr(esccor)
6863 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6864 c conformational states; temporarily implemented as differences
6865 c between UNRES torsional potentials (dependent on three types of
6866 c residues) and the torsional potentials dependent on all 20 types
6867 c of residues computed from AM1 energy surfaces of terminally-blocked
6868 c amino-acid residues.
6869 implicit real*8 (a-h,o-z)
6870 include 'DIMENSIONS'
6871 include 'DIMENSIONS.ZSCOPT'
6872 include 'COMMON.VAR'
6873 include 'COMMON.GEO'
6874 include 'COMMON.LOCAL'
6875 include 'COMMON.TORSION'
6876 include 'COMMON.SCCOR'
6877 include 'COMMON.INTERACT'
6878 include 'COMMON.DERIV'
6879 include 'COMMON.CHAIN'
6880 include 'COMMON.NAMES'
6881 include 'COMMON.IOUNITS'
6882 include 'COMMON.FFIELD'
6883 include 'COMMON.CONTROL'
6885 C Set lprn=.true. for debugging
6888 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6890 do i=itau_start,itau_end
6891 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6893 isccori=isccortyp(itype(i-2))
6894 isccori1=isccortyp(itype(i-1))
6896 do intertyp=1,3 !intertyp
6897 cc Added 09 May 2012 (Adasko)
6898 cc Intertyp means interaction type of backbone mainchain correlation:
6899 c 1 = SC...Ca...Ca...Ca
6900 c 2 = Ca...Ca...Ca...SC
6901 c 3 = SC...Ca...Ca...SCi
6903 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6904 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6905 & (itype(i-1).eq.ntyp1)))
6906 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6907 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6908 & .or.(itype(i).eq.ntyp1)))
6909 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6910 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6911 & (itype(i-3).eq.ntyp1)))) cycle
6912 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6913 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6915 do j=1,nterm_sccor(isccori,isccori1)
6916 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6917 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6918 cosphi=dcos(j*tauangle(intertyp,i))
6919 sinphi=dsin(j*tauangle(intertyp,i))
6920 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6921 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6923 C write (iout,*)"EBACK_SC_COR",esccor,i
6924 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6925 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6926 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6928 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6929 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6930 & (v1sccor(j,1,itori,itori1),j=1,6)
6931 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6932 c gsccor_loc(i-3)=gloci
6937 c------------------------------------------------------------------------------
6938 subroutine multibody(ecorr)
6939 C This subroutine calculates multi-body contributions to energy following
6940 C the idea of Skolnick et al. If side chains I and J make a contact and
6941 C at the same time side chains I+1 and J+1 make a contact, an extra
6942 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6943 implicit real*8 (a-h,o-z)
6944 include 'DIMENSIONS'
6945 include 'COMMON.IOUNITS'
6946 include 'COMMON.DERIV'
6947 include 'COMMON.INTERACT'
6948 include 'COMMON.CONTACTS'
6949 double precision gx(3),gx1(3)
6952 C Set lprn=.true. for debugging
6956 write (iout,'(a)') 'Contact function values:'
6958 write (iout,'(i2,20(1x,i2,f10.5))')
6959 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6974 num_conti=num_cont(i)
6975 num_conti1=num_cont(i1)
6980 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6981 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6982 cd & ' ishift=',ishift
6983 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6984 C The system gains extra energy.
6985 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6986 endif ! j1==j+-ishift
6995 c------------------------------------------------------------------------------
6996 double precision function esccorr(i,j,k,l,jj,kk)
6997 implicit real*8 (a-h,o-z)
6998 include 'DIMENSIONS'
6999 include 'COMMON.IOUNITS'
7000 include 'COMMON.DERIV'
7001 include 'COMMON.INTERACT'
7002 include 'COMMON.CONTACTS'
7003 double precision gx(3),gx1(3)
7008 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7009 C Calculate the multi-body contribution to energy.
7010 C Calculate multi-body contributions to the gradient.
7011 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7012 cd & k,l,(gacont(m,kk,k),m=1,3)
7014 gx(m) =ekl*gacont(m,jj,i)
7015 gx1(m)=eij*gacont(m,kk,k)
7016 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7017 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7018 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7019 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7023 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7028 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7034 c------------------------------------------------------------------------------
7035 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7036 C This subroutine calculates multi-body contributions to hydrogen-bonding
7037 implicit real*8 (a-h,o-z)
7038 include 'DIMENSIONS'
7039 include 'DIMENSIONS.ZSCOPT'
7040 include 'COMMON.IOUNITS'
7041 include 'COMMON.FFIELD'
7042 include 'COMMON.DERIV'
7043 include 'COMMON.INTERACT'
7044 include 'COMMON.CONTACTS'
7045 double precision gx(3),gx1(3)
7048 C Set lprn=.true. for debugging
7051 write (iout,'(a)') 'Contact function values:'
7053 write (iout,'(2i3,50(1x,i2,f5.2))')
7054 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7055 & j=1,num_cont_hb(i))
7059 C Remove the loop below after debugging !!!
7066 C Calculate the local-electrostatic correlation terms
7067 do i=iatel_s,iatel_e+1
7069 num_conti=num_cont_hb(i)
7070 num_conti1=num_cont_hb(i+1)
7075 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7076 c & ' jj=',jj,' kk=',kk
7077 if (j1.eq.j+1 .or. j1.eq.j-1) then
7078 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7079 C The system gains extra energy.
7080 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7082 else if (j1.eq.j) then
7083 C Contacts I-J and I-(J+1) occur simultaneously.
7084 C The system loses extra energy.
7085 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7090 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7091 c & ' jj=',jj,' kk=',kk
7093 C Contacts I-J and (I+1)-J occur simultaneously.
7094 C The system loses extra energy.
7095 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7102 c------------------------------------------------------------------------------
7103 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7105 C This subroutine calculates multi-body contributions to hydrogen-bonding
7106 implicit real*8 (a-h,o-z)
7107 include 'DIMENSIONS'
7108 include 'DIMENSIONS.ZSCOPT'
7109 include 'COMMON.IOUNITS'
7113 include 'COMMON.FFIELD'
7114 include 'COMMON.DERIV'
7115 include 'COMMON.LOCAL'
7116 include 'COMMON.INTERACT'
7117 include 'COMMON.CONTACTS'
7118 include 'COMMON.CHAIN'
7119 include 'COMMON.CONTROL'
7120 include 'COMMON.SHIELD'
7121 double precision gx(3),gx1(3)
7122 integer num_cont_hb_old(maxres)
7124 double precision eello4,eello5,eelo6,eello_turn6
7125 external eello4,eello5,eello6,eello_turn6
7126 C Set lprn=.true. for debugging
7130 write (iout,'(a)') 'Contact function values:'
7132 write (iout,'(2i3,50(1x,i2,5f6.3))')
7133 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7134 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7140 C Remove the loop below after debugging !!!
7147 C Calculate the dipole-dipole interaction energies
7148 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7149 do i=iatel_s,iatel_e+1
7150 num_conti=num_cont_hb(i)
7159 C Calculate the local-electrostatic correlation terms
7160 c write (iout,*) "gradcorr5 in eello5 before loop"
7162 c write (iout,'(i5,3f10.5)')
7163 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7165 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7166 c write (iout,*) "corr loop i",i
7168 num_conti=num_cont_hb(i)
7169 num_conti1=num_cont_hb(i+1)
7176 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7177 c & ' jj=',jj,' kk=',kk
7178 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7179 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7180 & .or. j.lt.0 .and. j1.gt.0) .and.
7181 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7182 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7183 C The system gains extra energy.
7185 sqd1=dsqrt(d_cont(jj,i))
7186 sqd2=dsqrt(d_cont(kk,i1))
7187 sred_geom = sqd1*sqd2
7188 IF (sred_geom.lt.cutoff_corr) THEN
7189 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7191 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7192 cd & ' jj=',jj,' kk=',kk
7193 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7194 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7196 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7197 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7200 cd write (iout,*) 'sred_geom=',sred_geom,
7201 cd & ' ekont=',ekont,' fprim=',fprimcont,
7202 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7203 cd write (iout,*) "g_contij",g_contij
7204 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7205 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7206 call calc_eello(i,jp,i+1,jp1,jj,kk)
7207 if (wcorr4.gt.0.0d0)
7208 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7209 CC & *fac_shield(i)**2*fac_shield(j)**2
7210 if (energy_dec.and.wcorr4.gt.0.0d0)
7211 1 write (iout,'(a6,4i5,0pf7.3)')
7212 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7213 c write (iout,*) "gradcorr5 before eello5"
7215 c write (iout,'(i5,3f10.5)')
7216 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7218 if (wcorr5.gt.0.0d0)
7219 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7220 c write (iout,*) "gradcorr5 after eello5"
7222 c write (iout,'(i5,3f10.5)')
7223 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7225 if (energy_dec.and.wcorr5.gt.0.0d0)
7226 1 write (iout,'(a6,4i5,0pf7.3)')
7227 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7228 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7229 cd write(2,*)'ijkl',i,jp,i+1,jp1
7230 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7231 & .or. wturn6.eq.0.0d0))then
7232 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7233 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7234 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7235 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7236 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7237 cd & 'ecorr6=',ecorr6
7238 cd write (iout,'(4e15.5)') sred_geom,
7239 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7240 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7241 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7242 else if (wturn6.gt.0.0d0
7243 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7244 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7245 eturn6=eturn6+eello_turn6(i,jj,kk)
7246 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7247 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7248 cd write (2,*) 'multibody_eello:eturn6',eturn6
7257 num_cont_hb(i)=num_cont_hb_old(i)
7259 c write (iout,*) "gradcorr5 in eello5"
7261 c write (iout,'(i5,3f10.5)')
7262 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7266 c------------------------------------------------------------------------------
7267 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7268 implicit real*8 (a-h,o-z)
7269 include 'DIMENSIONS'
7270 include 'DIMENSIONS.ZSCOPT'
7271 include 'COMMON.IOUNITS'
7272 include 'COMMON.DERIV'
7273 include 'COMMON.INTERACT'
7274 include 'COMMON.CONTACTS'
7275 include 'COMMON.SHIELD'
7276 include 'COMMON.CONTROL'
7277 double precision gx(3),gx1(3)
7280 C print *,"wchodze",fac_shield(i),shield_mode
7288 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7290 C & fac_shield(i)**2*fac_shield(j)**2
7291 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7292 C Following 4 lines for diagnostics.
7297 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7298 c & 'Contacts ',i,j,
7299 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7300 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7302 C Calculate the multi-body contribution to energy.
7303 C ecorr=ecorr+ekont*ees
7304 C Calculate multi-body contributions to the gradient.
7305 coeffpees0pij=coeffp*ees0pij
7306 coeffmees0mij=coeffm*ees0mij
7307 coeffpees0pkl=coeffp*ees0pkl
7308 coeffmees0mkl=coeffm*ees0mkl
7310 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7311 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7312 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7313 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7314 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7315 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7316 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7317 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7318 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7319 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7320 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7321 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7322 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7323 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7324 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7325 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7326 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7327 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7328 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7329 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7330 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7331 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7332 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7333 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7334 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7339 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7340 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7341 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7342 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7347 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7348 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7349 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7350 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7353 c write (iout,*) "ehbcorr",ekont*ees
7354 C print *,ekont,ees,i,k
7356 C now gradient over shielding
7358 if (shield_mode.gt.0) then
7361 C print *,i,j,fac_shield(i),fac_shield(j),
7362 C &fac_shield(k),fac_shield(l)
7363 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
7364 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7365 do ilist=1,ishield_list(i)
7366 iresshield=shield_list(ilist,i)
7368 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7370 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7372 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7373 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7377 do ilist=1,ishield_list(j)
7378 iresshield=shield_list(ilist,j)
7380 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7382 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7384 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7385 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7390 do ilist=1,ishield_list(k)
7391 iresshield=shield_list(ilist,k)
7393 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7395 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7397 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7398 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7402 do ilist=1,ishield_list(l)
7403 iresshield=shield_list(ilist,l)
7405 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7407 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7409 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7410 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7414 C print *,gshieldx(m,iresshield)
7416 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
7417 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7418 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
7419 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7420 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
7421 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7422 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
7423 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7425 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
7426 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7427 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
7428 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7429 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
7430 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7431 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
7432 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7440 C---------------------------------------------------------------------------
7441 subroutine dipole(i,j,jj)
7442 implicit real*8 (a-h,o-z)
7443 include 'DIMENSIONS'
7444 include 'DIMENSIONS.ZSCOPT'
7445 include 'COMMON.IOUNITS'
7446 include 'COMMON.CHAIN'
7447 include 'COMMON.FFIELD'
7448 include 'COMMON.DERIV'
7449 include 'COMMON.INTERACT'
7450 include 'COMMON.CONTACTS'
7451 include 'COMMON.TORSION'
7452 include 'COMMON.VAR'
7453 include 'COMMON.GEO'
7454 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7456 iti1 = itortyp(itype(i+1))
7457 if (j.lt.nres-1) then
7458 itj1 = itype2loc(itype(j+1))
7463 dipi(iii,1)=Ub2(iii,i)
7464 dipderi(iii)=Ub2der(iii,i)
7465 dipi(iii,2)=b1(iii,i+1)
7466 dipj(iii,1)=Ub2(iii,j)
7467 dipderj(iii)=Ub2der(iii,j)
7468 dipj(iii,2)=b1(iii,j+1)
7472 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7475 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7482 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7486 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7491 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7492 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7494 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7496 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7498 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7503 C---------------------------------------------------------------------------
7504 subroutine calc_eello(i,j,k,l,jj,kk)
7506 C This subroutine computes matrices and vectors needed to calculate
7507 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7509 implicit real*8 (a-h,o-z)
7510 include 'DIMENSIONS'
7511 include 'DIMENSIONS.ZSCOPT'
7512 include 'COMMON.IOUNITS'
7513 include 'COMMON.CHAIN'
7514 include 'COMMON.DERIV'
7515 include 'COMMON.INTERACT'
7516 include 'COMMON.CONTACTS'
7517 include 'COMMON.TORSION'
7518 include 'COMMON.VAR'
7519 include 'COMMON.GEO'
7520 include 'COMMON.FFIELD'
7521 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7522 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7525 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7526 cd & ' jj=',jj,' kk=',kk
7527 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7528 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7529 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7532 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7533 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7536 call transpose2(aa1(1,1),aa1t(1,1))
7537 call transpose2(aa2(1,1),aa2t(1,1))
7540 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7541 & aa1tder(1,1,lll,kkk))
7542 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7543 & aa2tder(1,1,lll,kkk))
7547 C parallel orientation of the two CA-CA-CA frames.
7549 iti=itype2loc(itype(i))
7553 itk1=itype2loc(itype(k+1))
7554 itj=itype2loc(itype(j))
7555 if (l.lt.nres-1) then
7556 itl1=itype2loc(itype(l+1))
7560 C A1 kernel(j+1) A2T
7562 cd write (iout,'(3f10.5,5x,3f10.5)')
7563 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7565 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7566 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7567 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7568 C Following matrices are needed only for 6-th order cumulants
7569 IF (wcorr6.gt.0.0d0) THEN
7570 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7571 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7572 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7573 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7574 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7575 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7576 & ADtEAderx(1,1,1,1,1,1))
7578 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7579 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7580 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7581 & ADtEA1derx(1,1,1,1,1,1))
7583 C End 6-th order cumulants
7586 cd write (2,*) 'In calc_eello6'
7588 cd write (2,*) 'iii=',iii
7590 cd write (2,*) 'kkk=',kkk
7592 cd write (2,'(3(2f10.5),5x)')
7593 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7598 call transpose2(EUgder(1,1,k),auxmat(1,1))
7599 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7600 call transpose2(EUg(1,1,k),auxmat(1,1))
7601 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7602 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7606 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7607 & EAEAderx(1,1,lll,kkk,iii,1))
7611 C A1T kernel(i+1) A2
7612 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7613 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7614 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7615 C Following matrices are needed only for 6-th order cumulants
7616 IF (wcorr6.gt.0.0d0) THEN
7617 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7618 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7619 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7620 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7621 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7622 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7623 & ADtEAderx(1,1,1,1,1,2))
7624 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7625 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7626 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7627 & ADtEA1derx(1,1,1,1,1,2))
7629 C End 6-th order cumulants
7630 call transpose2(EUgder(1,1,l),auxmat(1,1))
7631 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7632 call transpose2(EUg(1,1,l),auxmat(1,1))
7633 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7634 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7638 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7639 & EAEAderx(1,1,lll,kkk,iii,2))
7644 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7645 C They are needed only when the fifth- or the sixth-order cumulants are
7647 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7648 call transpose2(AEA(1,1,1),auxmat(1,1))
7649 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7650 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7651 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7652 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7653 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7654 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7655 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7656 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7657 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7658 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7659 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7660 call transpose2(AEA(1,1,2),auxmat(1,1))
7661 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7662 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7663 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7664 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7665 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7666 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7667 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7668 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7669 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7670 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7671 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7672 C Calculate the Cartesian derivatives of the vectors.
7676 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7677 call matvec2(auxmat(1,1),b1(1,i),
7678 & AEAb1derx(1,lll,kkk,iii,1,1))
7679 call matvec2(auxmat(1,1),Ub2(1,i),
7680 & AEAb2derx(1,lll,kkk,iii,1,1))
7681 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7682 & AEAb1derx(1,lll,kkk,iii,2,1))
7683 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7684 & AEAb2derx(1,lll,kkk,iii,2,1))
7685 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7686 call matvec2(auxmat(1,1),b1(1,j),
7687 & AEAb1derx(1,lll,kkk,iii,1,2))
7688 call matvec2(auxmat(1,1),Ub2(1,j),
7689 & AEAb2derx(1,lll,kkk,iii,1,2))
7690 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7691 & AEAb1derx(1,lll,kkk,iii,2,2))
7692 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7693 & AEAb2derx(1,lll,kkk,iii,2,2))
7700 C Antiparallel orientation of the two CA-CA-CA frames.
7702 iti=itype2loc(itype(i))
7706 itk1=itype2loc(itype(k+1))
7707 itl=itype2loc(itype(l))
7708 itj=itype2loc(itype(j))
7709 if (j.lt.nres-1) then
7710 itj1=itype2loc(itype(j+1))
7714 C A2 kernel(j-1)T A1T
7715 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7716 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7717 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7718 C Following matrices are needed only for 6-th order cumulants
7719 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7720 & j.eq.i+4 .and. l.eq.i+3)) THEN
7721 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7722 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7723 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7724 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7725 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7726 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7727 & ADtEAderx(1,1,1,1,1,1))
7728 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7729 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7730 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7731 & ADtEA1derx(1,1,1,1,1,1))
7733 C End 6-th order cumulants
7734 call transpose2(EUgder(1,1,k),auxmat(1,1))
7735 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7736 call transpose2(EUg(1,1,k),auxmat(1,1))
7737 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7738 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7742 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7743 & EAEAderx(1,1,lll,kkk,iii,1))
7747 C A2T kernel(i+1)T A1
7748 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7749 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7750 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7751 C Following matrices are needed only for 6-th order cumulants
7752 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7753 & j.eq.i+4 .and. l.eq.i+3)) THEN
7754 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7755 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7756 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7757 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7758 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7759 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7760 & ADtEAderx(1,1,1,1,1,2))
7761 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7762 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7763 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7764 & ADtEA1derx(1,1,1,1,1,2))
7766 C End 6-th order cumulants
7767 call transpose2(EUgder(1,1,j),auxmat(1,1))
7768 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7769 call transpose2(EUg(1,1,j),auxmat(1,1))
7770 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7771 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7775 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7776 & EAEAderx(1,1,lll,kkk,iii,2))
7781 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7782 C They are needed only when the fifth- or the sixth-order cumulants are
7784 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7785 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7786 call transpose2(AEA(1,1,1),auxmat(1,1))
7787 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7788 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7789 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7790 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7791 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7792 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7793 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7794 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7795 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7796 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7797 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7798 call transpose2(AEA(1,1,2),auxmat(1,1))
7799 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7800 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7801 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7802 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7803 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7804 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7805 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7806 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7807 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7808 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7809 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7810 C Calculate the Cartesian derivatives of the vectors.
7814 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7815 call matvec2(auxmat(1,1),b1(1,i),
7816 & AEAb1derx(1,lll,kkk,iii,1,1))
7817 call matvec2(auxmat(1,1),Ub2(1,i),
7818 & AEAb2derx(1,lll,kkk,iii,1,1))
7819 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7820 & AEAb1derx(1,lll,kkk,iii,2,1))
7821 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7822 & AEAb2derx(1,lll,kkk,iii,2,1))
7823 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7824 call matvec2(auxmat(1,1),b1(1,l),
7825 & AEAb1derx(1,lll,kkk,iii,1,2))
7826 call matvec2(auxmat(1,1),Ub2(1,l),
7827 & AEAb2derx(1,lll,kkk,iii,1,2))
7828 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7829 & AEAb1derx(1,lll,kkk,iii,2,2))
7830 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7831 & AEAb2derx(1,lll,kkk,iii,2,2))
7840 C---------------------------------------------------------------------------
7841 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7842 & KK,KKderg,AKA,AKAderg,AKAderx)
7846 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7847 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7848 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7853 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7855 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7858 cd if (lprn) write (2,*) 'In kernel'
7860 cd if (lprn) write (2,*) 'kkk=',kkk
7862 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7863 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7865 cd write (2,*) 'lll=',lll
7866 cd write (2,*) 'iii=1'
7868 cd write (2,'(3(2f10.5),5x)')
7869 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7872 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7873 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7875 cd write (2,*) 'lll=',lll
7876 cd write (2,*) 'iii=2'
7878 cd write (2,'(3(2f10.5),5x)')
7879 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7886 C---------------------------------------------------------------------------
7887 double precision function eello4(i,j,k,l,jj,kk)
7888 implicit real*8 (a-h,o-z)
7889 include 'DIMENSIONS'
7890 include 'DIMENSIONS.ZSCOPT'
7891 include 'COMMON.IOUNITS'
7892 include 'COMMON.CHAIN'
7893 include 'COMMON.DERIV'
7894 include 'COMMON.INTERACT'
7895 include 'COMMON.CONTACTS'
7896 include 'COMMON.TORSION'
7897 include 'COMMON.VAR'
7898 include 'COMMON.GEO'
7899 double precision pizda(2,2),ggg1(3),ggg2(3)
7900 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7904 cd print *,'eello4:',i,j,k,l,jj,kk
7905 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7906 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7907 cold eij=facont_hb(jj,i)
7908 cold ekl=facont_hb(kk,k)
7910 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7912 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7913 gcorr_loc(k-1)=gcorr_loc(k-1)
7914 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7916 gcorr_loc(l-1)=gcorr_loc(l-1)
7917 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7919 gcorr_loc(j-1)=gcorr_loc(j-1)
7920 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7925 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7926 & -EAEAderx(2,2,lll,kkk,iii,1)
7927 cd derx(lll,kkk,iii)=0.0d0
7931 cd gcorr_loc(l-1)=0.0d0
7932 cd gcorr_loc(j-1)=0.0d0
7933 cd gcorr_loc(k-1)=0.0d0
7935 cd write (iout,*)'Contacts have occurred for peptide groups',
7936 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7937 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7938 if (j.lt.nres-1) then
7945 if (l.lt.nres-1) then
7953 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7954 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7955 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7956 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7957 cgrad ghalf=0.5d0*ggg1(ll)
7958 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7959 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7960 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7961 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7962 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7963 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7964 cgrad ghalf=0.5d0*ggg2(ll)
7965 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7966 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7967 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7968 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7969 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7970 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7974 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7979 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7984 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7989 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7993 cd write (2,*) iii,gcorr_loc(iii)
7997 cd write (2,*) 'ekont',ekont
7998 cd write (iout,*) 'eello4',ekont*eel4
8001 C---------------------------------------------------------------------------
8002 double precision function eello5(i,j,k,l,jj,kk)
8003 implicit real*8 (a-h,o-z)
8004 include 'DIMENSIONS'
8005 include 'DIMENSIONS.ZSCOPT'
8006 include 'COMMON.IOUNITS'
8007 include 'COMMON.CHAIN'
8008 include 'COMMON.DERIV'
8009 include 'COMMON.INTERACT'
8010 include 'COMMON.CONTACTS'
8011 include 'COMMON.TORSION'
8012 include 'COMMON.VAR'
8013 include 'COMMON.GEO'
8014 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8015 double precision ggg1(3),ggg2(3)
8016 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8021 C /l\ / \ \ / \ / \ / C
8022 C / \ / \ \ / \ / \ / C
8023 C j| o |l1 | o | o| o | | o |o C
8024 C \ |/k\| |/ \| / |/ \| |/ \| C
8025 C \i/ \ / \ / / \ / \ C
8027 C (I) (II) (III) (IV) C
8029 C eello5_1 eello5_2 eello5_3 eello5_4 C
8031 C Antiparallel chains C
8034 C /j\ / \ \ / \ / \ / C
8035 C / \ / \ \ / \ / \ / C
8036 C j1| o |l | o | o| o | | o |o C
8037 C \ |/k\| |/ \| / |/ \| |/ \| C
8038 C \i/ \ / \ / / \ / \ C
8040 C (I) (II) (III) (IV) C
8042 C eello5_1 eello5_2 eello5_3 eello5_4 C
8044 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8046 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8047 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8052 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8054 itk=itype2loc(itype(k))
8055 itl=itype2loc(itype(l))
8056 itj=itype2loc(itype(j))
8061 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8062 cd & eel5_3_num,eel5_4_num)
8066 derx(lll,kkk,iii)=0.0d0
8070 cd eij=facont_hb(jj,i)
8071 cd ekl=facont_hb(kk,k)
8073 cd write (iout,*)'Contacts have occurred for peptide groups',
8074 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8076 C Contribution from the graph I.
8077 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8078 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8079 call transpose2(EUg(1,1,k),auxmat(1,1))
8080 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8081 vv(1)=pizda(1,1)-pizda(2,2)
8082 vv(2)=pizda(1,2)+pizda(2,1)
8083 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8084 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8086 C Explicit gradient in virtual-dihedral angles.
8087 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8088 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8089 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8090 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8091 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8092 vv(1)=pizda(1,1)-pizda(2,2)
8093 vv(2)=pizda(1,2)+pizda(2,1)
8094 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8095 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8096 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8097 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8098 vv(1)=pizda(1,1)-pizda(2,2)
8099 vv(2)=pizda(1,2)+pizda(2,1)
8101 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8102 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8103 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8105 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8106 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8107 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8109 C Cartesian gradient
8113 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8115 vv(1)=pizda(1,1)-pizda(2,2)
8116 vv(2)=pizda(1,2)+pizda(2,1)
8117 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8118 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8119 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8126 C Contribution from graph II
8127 call transpose2(EE(1,1,k),auxmat(1,1))
8128 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8129 vv(1)=pizda(1,1)+pizda(2,2)
8130 vv(2)=pizda(2,1)-pizda(1,2)
8131 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8132 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8134 C Explicit gradient in virtual-dihedral angles.
8135 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8136 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8137 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8138 vv(1)=pizda(1,1)+pizda(2,2)
8139 vv(2)=pizda(2,1)-pizda(1,2)
8141 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8142 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8143 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8145 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8146 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8147 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8149 C Cartesian gradient
8153 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8155 vv(1)=pizda(1,1)+pizda(2,2)
8156 vv(2)=pizda(2,1)-pizda(1,2)
8157 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8158 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8159 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8168 C Parallel orientation
8169 C Contribution from graph III
8170 call transpose2(EUg(1,1,l),auxmat(1,1))
8171 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8172 vv(1)=pizda(1,1)-pizda(2,2)
8173 vv(2)=pizda(1,2)+pizda(2,1)
8174 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8175 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8177 C Explicit gradient in virtual-dihedral angles.
8178 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8179 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8180 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8181 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8182 vv(1)=pizda(1,1)-pizda(2,2)
8183 vv(2)=pizda(1,2)+pizda(2,1)
8184 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8185 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8186 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8187 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8188 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8189 vv(1)=pizda(1,1)-pizda(2,2)
8190 vv(2)=pizda(1,2)+pizda(2,1)
8191 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8192 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8193 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8194 C Cartesian gradient
8198 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8200 vv(1)=pizda(1,1)-pizda(2,2)
8201 vv(2)=pizda(1,2)+pizda(2,1)
8202 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8203 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8204 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8209 C Contribution from graph IV
8211 call transpose2(EE(1,1,l),auxmat(1,1))
8212 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8213 vv(1)=pizda(1,1)+pizda(2,2)
8214 vv(2)=pizda(2,1)-pizda(1,2)
8215 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8216 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8217 C Explicit gradient in virtual-dihedral angles.
8218 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8219 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8220 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8221 vv(1)=pizda(1,1)+pizda(2,2)
8222 vv(2)=pizda(2,1)-pizda(1,2)
8223 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8224 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8225 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8226 C Cartesian gradient
8230 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8232 vv(1)=pizda(1,1)+pizda(2,2)
8233 vv(2)=pizda(2,1)-pizda(1,2)
8234 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8235 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8236 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8242 C Antiparallel orientation
8243 C Contribution from graph III
8245 call transpose2(EUg(1,1,j),auxmat(1,1))
8246 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8247 vv(1)=pizda(1,1)-pizda(2,2)
8248 vv(2)=pizda(1,2)+pizda(2,1)
8249 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8250 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8252 C Explicit gradient in virtual-dihedral angles.
8253 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8254 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8255 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8256 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8257 vv(1)=pizda(1,1)-pizda(2,2)
8258 vv(2)=pizda(1,2)+pizda(2,1)
8259 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8260 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8261 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8262 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8263 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8264 vv(1)=pizda(1,1)-pizda(2,2)
8265 vv(2)=pizda(1,2)+pizda(2,1)
8266 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8267 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8268 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8269 C Cartesian gradient
8273 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8275 vv(1)=pizda(1,1)-pizda(2,2)
8276 vv(2)=pizda(1,2)+pizda(2,1)
8277 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8278 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8279 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8285 C Contribution from graph IV
8287 call transpose2(EE(1,1,j),auxmat(1,1))
8288 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8289 vv(1)=pizda(1,1)+pizda(2,2)
8290 vv(2)=pizda(2,1)-pizda(1,2)
8291 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8292 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8294 C Explicit gradient in virtual-dihedral angles.
8295 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8296 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8297 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8298 vv(1)=pizda(1,1)+pizda(2,2)
8299 vv(2)=pizda(2,1)-pizda(1,2)
8300 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8301 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8302 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8303 C Cartesian gradient
8307 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8309 vv(1)=pizda(1,1)+pizda(2,2)
8310 vv(2)=pizda(2,1)-pizda(1,2)
8311 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8312 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8313 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8320 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8321 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8322 cd write (2,*) 'ijkl',i,j,k,l
8323 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8324 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8326 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8327 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8328 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8329 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8331 if (j.lt.nres-1) then
8338 if (l.lt.nres-1) then
8348 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8349 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8350 C summed up outside the subrouine as for the other subroutines
8351 C handling long-range interactions. The old code is commented out
8352 C with "cgrad" to keep track of changes.
8354 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8355 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8356 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8357 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8358 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8359 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8360 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8361 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8362 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8363 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8365 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8366 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8367 cgrad ghalf=0.5d0*ggg1(ll)
8369 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8370 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8371 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8372 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8373 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8374 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8375 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8376 cgrad ghalf=0.5d0*ggg2(ll)
8378 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
8379 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8380 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
8381 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8382 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8383 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8389 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8390 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8395 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8396 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8402 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8407 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8411 cd write (2,*) iii,g_corr5_loc(iii)
8414 cd write (2,*) 'ekont',ekont
8415 cd write (iout,*) 'eello5',ekont*eel5
8418 c--------------------------------------------------------------------------
8419 double precision function eello6(i,j,k,l,jj,kk)
8420 implicit real*8 (a-h,o-z)
8421 include 'DIMENSIONS'
8422 include 'DIMENSIONS.ZSCOPT'
8423 include 'COMMON.IOUNITS'
8424 include 'COMMON.CHAIN'
8425 include 'COMMON.DERIV'
8426 include 'COMMON.INTERACT'
8427 include 'COMMON.CONTACTS'
8428 include 'COMMON.TORSION'
8429 include 'COMMON.VAR'
8430 include 'COMMON.GEO'
8431 include 'COMMON.FFIELD'
8432 double precision ggg1(3),ggg2(3)
8433 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8438 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8446 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8447 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8451 derx(lll,kkk,iii)=0.0d0
8455 cd eij=facont_hb(jj,i)
8456 cd ekl=facont_hb(kk,k)
8462 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8463 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8464 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8465 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8466 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8467 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8469 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8470 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8471 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8472 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8473 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8474 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8478 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8480 C If turn contributions are considered, they will be handled separately.
8481 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8482 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8483 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8484 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8485 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8486 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8487 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8490 if (j.lt.nres-1) then
8497 if (l.lt.nres-1) then
8505 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8506 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8507 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8508 cgrad ghalf=0.5d0*ggg1(ll)
8510 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8511 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8512 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8513 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8514 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8515 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8516 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8517 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8518 cgrad ghalf=0.5d0*ggg2(ll)
8519 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8521 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8522 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8523 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8524 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8525 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8526 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8532 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8533 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8538 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8539 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8545 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8550 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8554 cd write (2,*) iii,g_corr6_loc(iii)
8557 cd write (2,*) 'ekont',ekont
8558 cd write (iout,*) 'eello6',ekont*eel6
8561 c--------------------------------------------------------------------------
8562 double precision function eello6_graph1(i,j,k,l,imat,swap)
8563 implicit real*8 (a-h,o-z)
8564 include 'DIMENSIONS'
8565 include 'DIMENSIONS.ZSCOPT'
8566 include 'COMMON.IOUNITS'
8567 include 'COMMON.CHAIN'
8568 include 'COMMON.DERIV'
8569 include 'COMMON.INTERACT'
8570 include 'COMMON.CONTACTS'
8571 include 'COMMON.TORSION'
8572 include 'COMMON.VAR'
8573 include 'COMMON.GEO'
8574 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8578 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8580 C Parallel Antiparallel C
8586 C \ j|/k\| / \ |/k\|l / C
8591 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8592 itk=itype2loc(itype(k))
8593 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8594 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8595 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8596 call transpose2(EUgC(1,1,k),auxmat(1,1))
8597 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8598 vv1(1)=pizda1(1,1)-pizda1(2,2)
8599 vv1(2)=pizda1(1,2)+pizda1(2,1)
8600 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8601 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8602 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8603 s5=scalar2(vv(1),Dtobr2(1,i))
8604 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8605 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8607 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8608 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8609 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8610 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8611 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8612 & +scalar2(vv(1),Dtobr2der(1,i)))
8613 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8614 vv1(1)=pizda1(1,1)-pizda1(2,2)
8615 vv1(2)=pizda1(1,2)+pizda1(2,1)
8616 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8617 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8619 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8620 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8621 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8622 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8623 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8625 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8626 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8627 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8628 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8629 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8631 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8632 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8633 vv1(1)=pizda1(1,1)-pizda1(2,2)
8634 vv1(2)=pizda1(1,2)+pizda1(2,1)
8635 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8636 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8637 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8638 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8647 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8648 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8649 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8650 call transpose2(EUgC(1,1,k),auxmat(1,1))
8651 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8653 vv1(1)=pizda1(1,1)-pizda1(2,2)
8654 vv1(2)=pizda1(1,2)+pizda1(2,1)
8655 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8656 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8657 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8658 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8659 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8660 s5=scalar2(vv(1),Dtobr2(1,i))
8661 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8668 c----------------------------------------------------------------------------
8669 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8670 implicit real*8 (a-h,o-z)
8671 include 'DIMENSIONS'
8672 include 'DIMENSIONS.ZSCOPT'
8673 include 'COMMON.IOUNITS'
8674 include 'COMMON.CHAIN'
8675 include 'COMMON.DERIV'
8676 include 'COMMON.INTERACT'
8677 include 'COMMON.CONTACTS'
8678 include 'COMMON.TORSION'
8679 include 'COMMON.VAR'
8680 include 'COMMON.GEO'
8682 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8683 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8686 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8688 C Parallel Antiparallel C
8694 C \ j|/k\| \ |/k\|l C
8699 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8700 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8701 C AL 7/4/01 s1 would occur in the sixth-order moment,
8702 C but not in a cluster cumulant
8704 s1=dip(1,jj,i)*dip(1,kk,k)
8706 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8707 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8708 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8709 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8710 call transpose2(EUg(1,1,k),auxmat(1,1))
8711 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8712 vv(1)=pizda(1,1)-pizda(2,2)
8713 vv(2)=pizda(1,2)+pizda(2,1)
8714 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8715 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8717 eello6_graph2=-(s1+s2+s3+s4)
8719 eello6_graph2=-(s2+s3+s4)
8722 C Derivatives in gamma(i-1)
8726 s1=dipderg(1,jj,i)*dip(1,kk,k)
8728 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8729 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8730 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8731 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8733 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8735 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8737 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8739 C Derivatives in gamma(k-1)
8741 s1=dip(1,jj,i)*dipderg(1,kk,k)
8743 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8744 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8745 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8746 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8747 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8748 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8749 vv(1)=pizda(1,1)-pizda(2,2)
8750 vv(2)=pizda(1,2)+pizda(2,1)
8751 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8753 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8755 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8757 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8758 C Derivatives in gamma(j-1) or gamma(l-1)
8761 s1=dipderg(3,jj,i)*dip(1,kk,k)
8763 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8764 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8765 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8766 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8767 vv(1)=pizda(1,1)-pizda(2,2)
8768 vv(2)=pizda(1,2)+pizda(2,1)
8769 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8772 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8774 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8777 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8778 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8780 C Derivatives in gamma(l-1) or gamma(j-1)
8783 s1=dip(1,jj,i)*dipderg(3,kk,k)
8785 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8786 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8787 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8788 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8789 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8790 vv(1)=pizda(1,1)-pizda(2,2)
8791 vv(2)=pizda(1,2)+pizda(2,1)
8792 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8795 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8797 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8800 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8801 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8803 C Cartesian derivatives.
8805 write (2,*) 'In eello6_graph2'
8807 write (2,*) 'iii=',iii
8809 write (2,*) 'kkk=',kkk
8811 write (2,'(3(2f10.5),5x)')
8812 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8822 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8824 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8827 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8829 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8830 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8832 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8833 call transpose2(EUg(1,1,k),auxmat(1,1))
8834 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8836 vv(1)=pizda(1,1)-pizda(2,2)
8837 vv(2)=pizda(1,2)+pizda(2,1)
8838 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8839 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8841 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8843 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8846 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8848 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8856 c----------------------------------------------------------------------------
8857 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8858 implicit real*8 (a-h,o-z)
8859 include 'DIMENSIONS'
8860 include 'DIMENSIONS.ZSCOPT'
8861 include 'COMMON.IOUNITS'
8862 include 'COMMON.CHAIN'
8863 include 'COMMON.DERIV'
8864 include 'COMMON.INTERACT'
8865 include 'COMMON.CONTACTS'
8866 include 'COMMON.TORSION'
8867 include 'COMMON.VAR'
8868 include 'COMMON.GEO'
8869 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8871 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8873 C Parallel Antiparallel C
8879 C j|/k\| / |/k\|l / C
8884 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8886 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8887 C energy moment and not to the cluster cumulant.
8888 iti=itortyp(itype(i))
8889 if (j.lt.nres-1) then
8890 itj1=itype2loc(itype(j+1))
8894 itk=itype2loc(itype(k))
8895 itk1=itype2loc(itype(k+1))
8896 if (l.lt.nres-1) then
8897 itl1=itype2loc(itype(l+1))
8902 s1=dip(4,jj,i)*dip(4,kk,k)
8904 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8905 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8906 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8907 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8908 call transpose2(EE(1,1,k),auxmat(1,1))
8909 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8910 vv(1)=pizda(1,1)+pizda(2,2)
8911 vv(2)=pizda(2,1)-pizda(1,2)
8912 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8913 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8914 cd & "sum",-(s2+s3+s4)
8916 eello6_graph3=-(s1+s2+s3+s4)
8918 eello6_graph3=-(s2+s3+s4)
8921 C Derivatives in gamma(k-1)
8923 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8924 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8925 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8926 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8927 C Derivatives in gamma(l-1)
8928 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8929 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8930 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8931 vv(1)=pizda(1,1)+pizda(2,2)
8932 vv(2)=pizda(2,1)-pizda(1,2)
8933 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8934 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8935 C Cartesian derivatives.
8941 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8943 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8946 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8948 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8949 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8951 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8952 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8954 vv(1)=pizda(1,1)+pizda(2,2)
8955 vv(2)=pizda(2,1)-pizda(1,2)
8956 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8958 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8960 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8963 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8965 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8967 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8974 c----------------------------------------------------------------------------
8975 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8976 implicit real*8 (a-h,o-z)
8977 include 'DIMENSIONS'
8978 include 'DIMENSIONS.ZSCOPT'
8979 include 'COMMON.IOUNITS'
8980 include 'COMMON.CHAIN'
8981 include 'COMMON.DERIV'
8982 include 'COMMON.INTERACT'
8983 include 'COMMON.CONTACTS'
8984 include 'COMMON.TORSION'
8985 include 'COMMON.VAR'
8986 include 'COMMON.GEO'
8987 include 'COMMON.FFIELD'
8988 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8989 & auxvec1(2),auxmat1(2,2)
8991 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8993 C Parallel Antiparallel C
8999 C \ j|/k\| \ |/k\|l C
9004 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9006 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9007 C energy moment and not to the cluster cumulant.
9008 cd write (2,*) 'eello_graph4: wturn6',wturn6
9009 iti=itype2loc(itype(i))
9010 itj=itype2loc(itype(j))
9011 if (j.lt.nres-1) then
9012 itj1=itype2loc(itype(j+1))
9016 itk=itype2loc(itype(k))
9017 if (k.lt.nres-1) then
9018 itk1=itype2loc(itype(k+1))
9022 itl=itype2loc(itype(l))
9023 if (l.lt.nres-1) then
9024 itl1=itype2loc(itype(l+1))
9028 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9029 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9030 cd & ' itl',itl,' itl1',itl1
9033 s1=dip(3,jj,i)*dip(3,kk,k)
9035 s1=dip(2,jj,j)*dip(2,kk,l)
9038 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9039 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9041 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9042 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9044 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9045 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9047 call transpose2(EUg(1,1,k),auxmat(1,1))
9048 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9049 vv(1)=pizda(1,1)-pizda(2,2)
9050 vv(2)=pizda(2,1)+pizda(1,2)
9051 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9052 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9054 eello6_graph4=-(s1+s2+s3+s4)
9056 eello6_graph4=-(s2+s3+s4)
9058 C Derivatives in gamma(i-1)
9063 s1=dipderg(2,jj,i)*dip(3,kk,k)
9065 s1=dipderg(4,jj,j)*dip(2,kk,l)
9068 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9070 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9071 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9073 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9074 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9076 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9077 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9078 cd write (2,*) 'turn6 derivatives'
9080 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9082 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9086 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9088 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9092 C Derivatives in gamma(k-1)
9095 s1=dip(3,jj,i)*dipderg(2,kk,k)
9097 s1=dip(2,jj,j)*dipderg(4,kk,l)
9100 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9101 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9103 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9104 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9106 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9107 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9109 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9110 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9111 vv(1)=pizda(1,1)-pizda(2,2)
9112 vv(2)=pizda(2,1)+pizda(1,2)
9113 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9114 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9116 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9118 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9122 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9124 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9127 C Derivatives in gamma(j-1) or gamma(l-1)
9128 if (l.eq.j+1 .and. l.gt.1) then
9129 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9130 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9131 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9132 vv(1)=pizda(1,1)-pizda(2,2)
9133 vv(2)=pizda(2,1)+pizda(1,2)
9134 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9135 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9136 else if (j.gt.1) then
9137 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9138 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9139 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9140 vv(1)=pizda(1,1)-pizda(2,2)
9141 vv(2)=pizda(2,1)+pizda(1,2)
9142 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9143 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9144 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9146 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9149 C Cartesian derivatives.
9156 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9158 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9162 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9164 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9168 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9170 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9172 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9173 & b1(1,j+1),auxvec(1))
9174 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9176 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9177 & b1(1,l+1),auxvec(1))
9178 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9180 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9182 vv(1)=pizda(1,1)-pizda(2,2)
9183 vv(2)=pizda(2,1)+pizda(1,2)
9184 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9186 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9188 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9191 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9194 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9197 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9199 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9201 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9205 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9207 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9210 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9212 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9221 c----------------------------------------------------------------------------
9222 double precision function eello_turn6(i,jj,kk)
9223 implicit real*8 (a-h,o-z)
9224 include 'DIMENSIONS'
9225 include 'DIMENSIONS.ZSCOPT'
9226 include 'COMMON.IOUNITS'
9227 include 'COMMON.CHAIN'
9228 include 'COMMON.DERIV'
9229 include 'COMMON.INTERACT'
9230 include 'COMMON.CONTACTS'
9231 include 'COMMON.TORSION'
9232 include 'COMMON.VAR'
9233 include 'COMMON.GEO'
9234 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9235 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9237 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9238 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9239 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9240 C the respective energy moment and not to the cluster cumulant.
9249 iti=itype2loc(itype(i))
9250 itk=itype2loc(itype(k))
9251 itk1=itype2loc(itype(k+1))
9252 itl=itype2loc(itype(l))
9253 itj=itype2loc(itype(j))
9254 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9255 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9256 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9261 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9263 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9267 derx_turn(lll,kkk,iii)=0.0d0
9274 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9276 cd write (2,*) 'eello6_5',eello6_5
9278 call transpose2(AEA(1,1,1),auxmat(1,1))
9279 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9280 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9281 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9283 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9284 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9285 s2 = scalar2(b1(1,k),vtemp1(1))
9287 call transpose2(AEA(1,1,2),atemp(1,1))
9288 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9289 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
9290 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9292 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9293 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9294 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9296 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9297 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9298 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9299 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9300 ss13 = scalar2(b1(1,k),vtemp4(1))
9301 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9303 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9309 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9310 C Derivatives in gamma(i+2)
9315 call transpose2(AEA(1,1,1),auxmatd(1,1))
9316 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9317 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9318 call transpose2(AEAderg(1,1,2),atempd(1,1))
9319 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9320 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9322 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9323 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9324 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9330 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9331 C Derivatives in gamma(i+3)
9333 call transpose2(AEA(1,1,1),auxmatd(1,1))
9334 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9335 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9336 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9338 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9339 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9340 s2d = scalar2(b1(1,k),vtemp1d(1))
9342 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
9343 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
9345 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9347 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9348 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9349 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9357 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9358 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9360 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9361 & -0.5d0*ekont*(s2d+s12d)
9363 C Derivatives in gamma(i+4)
9364 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9365 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9366 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9368 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9369 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9370 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9378 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9380 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9382 C Derivatives in gamma(i+5)
9384 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9385 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9386 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9388 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9389 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9390 s2d = scalar2(b1(1,k),vtemp1d(1))
9392 call transpose2(AEA(1,1,2),atempd(1,1))
9393 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9394 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9396 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9397 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9399 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9400 ss13d = scalar2(b1(1,k),vtemp4d(1))
9401 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9409 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9410 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9412 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9413 & -0.5d0*ekont*(s2d+s12d)
9415 C Cartesian derivatives
9420 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9421 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9422 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9424 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9425 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9427 s2d = scalar2(b1(1,k),vtemp1d(1))
9429 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9430 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9431 s8d = -(atempd(1,1)+atempd(2,2))*
9432 & scalar2(cc(1,1,l),vtemp2(1))
9434 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9436 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9437 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9444 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9447 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9451 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9452 & - 0.5d0*(s8d+s12d)
9454 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9463 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9465 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9466 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9467 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9468 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9469 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9471 ss13d = scalar2(b1(1,k),vtemp4d(1))
9472 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9473 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9477 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9478 cd & 16*eel_turn6_num
9480 if (j.lt.nres-1) then
9487 if (l.lt.nres-1) then
9495 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9496 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9497 cgrad ghalf=0.5d0*ggg1(ll)
9499 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9500 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9501 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9502 & +ekont*derx_turn(ll,2,1)
9503 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9504 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9505 & +ekont*derx_turn(ll,4,1)
9506 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9507 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9508 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9509 cgrad ghalf=0.5d0*ggg2(ll)
9511 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9512 & +ekont*derx_turn(ll,2,2)
9513 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9514 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9515 & +ekont*derx_turn(ll,4,2)
9516 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9517 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9518 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9523 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9528 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9534 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9539 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9543 cd write (2,*) iii,g_corr6_loc(iii)
9546 eello_turn6=ekont*eel_turn6
9547 cd write (2,*) 'ekont',ekont
9548 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9552 crc-------------------------------------------------
9553 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9554 subroutine Eliptransfer(eliptran)
9555 implicit real*8 (a-h,o-z)
9556 include 'DIMENSIONS'
9557 include 'DIMENSIONS.ZSCOPT'
9558 include 'COMMON.GEO'
9559 include 'COMMON.VAR'
9560 include 'COMMON.LOCAL'
9561 include 'COMMON.CHAIN'
9562 include 'COMMON.DERIV'
9563 include 'COMMON.INTERACT'
9564 include 'COMMON.IOUNITS'
9565 include 'COMMON.CALC'
9566 include 'COMMON.CONTROL'
9567 include 'COMMON.SPLITELE'
9568 include 'COMMON.SBRIDGE'
9569 C this is done by Adasko
9573 C--bordliptop-- buffore starts
9574 C--bufliptop--- here true lipid starts
9576 C--buflipbot--- lipid ends buffore starts
9577 C--bordlipbot--buffore ends
9581 if (itype(i).eq.ntyp1) cycle
9583 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9584 if (positi.le.0) positi=positi+boxzsize
9586 C first for peptide groups
9587 c for each residue check if it is in lipid or lipid water border area
9588 if ((positi.gt.bordlipbot)
9589 &.and.(positi.lt.bordliptop)) then
9590 C the energy transfer exist
9591 if (positi.lt.buflipbot) then
9592 C what fraction I am in
9594 & ((positi-bordlipbot)/lipbufthick)
9595 C lipbufthick is thickenes of lipid buffore
9596 sslip=sscalelip(fracinbuf)
9597 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9598 eliptran=eliptran+sslip*pepliptran
9599 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9600 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9601 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9602 elseif (positi.gt.bufliptop) then
9603 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9604 sslip=sscalelip(fracinbuf)
9605 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9606 eliptran=eliptran+sslip*pepliptran
9607 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9608 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9609 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9610 C print *, "doing sscalefor top part"
9611 C print *,i,sslip,fracinbuf,ssgradlip
9613 eliptran=eliptran+pepliptran
9614 C print *,"I am in true lipid"
9617 C eliptran=elpitran+0.0 ! I am in water
9620 C print *, "nic nie bylo w lipidzie?"
9621 C now multiply all by the peptide group transfer factor
9622 C eliptran=eliptran*pepliptran
9623 C now the same for side chains
9626 if (itype(i).eq.ntyp1) cycle
9627 positi=(mod(c(3,i+nres),boxzsize))
9628 if (positi.le.0) positi=positi+boxzsize
9629 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9630 c for each residue check if it is in lipid or lipid water border area
9631 C respos=mod(c(3,i+nres),boxzsize)
9632 C print *,positi,bordlipbot,buflipbot
9633 if ((positi.gt.bordlipbot)
9634 & .and.(positi.lt.bordliptop)) then
9635 C the energy transfer exist
9636 if (positi.lt.buflipbot) then
9638 & ((positi-bordlipbot)/lipbufthick)
9639 C lipbufthick is thickenes of lipid buffore
9640 sslip=sscalelip(fracinbuf)
9641 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9642 eliptran=eliptran+sslip*liptranene(itype(i))
9643 gliptranx(3,i)=gliptranx(3,i)
9644 &+ssgradlip*liptranene(itype(i))
9645 gliptranc(3,i-1)= gliptranc(3,i-1)
9646 &+ssgradlip*liptranene(itype(i))
9647 C print *,"doing sccale for lower part"
9648 elseif (positi.gt.bufliptop) then
9650 &((bordliptop-positi)/lipbufthick)
9651 sslip=sscalelip(fracinbuf)
9652 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9653 eliptran=eliptran+sslip*liptranene(itype(i))
9654 gliptranx(3,i)=gliptranx(3,i)
9655 &+ssgradlip*liptranene(itype(i))
9656 gliptranc(3,i-1)= gliptranc(3,i-1)
9657 &+ssgradlip*liptranene(itype(i))
9658 C print *, "doing sscalefor top part",sslip,fracinbuf
9660 eliptran=eliptran+liptranene(itype(i))
9661 C print *,"I am in true lipid"
9663 endif ! if in lipid or buffor
9665 C eliptran=elpitran+0.0 ! I am in water
9671 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9673 SUBROUTINE MATVEC2(A1,V1,V2)
9674 implicit real*8 (a-h,o-z)
9675 include 'DIMENSIONS'
9676 DIMENSION A1(2,2),V1(2),V2(2)
9680 c 3 VI=VI+A1(I,K)*V1(K)
9684 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9685 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9690 C---------------------------------------
9691 SUBROUTINE MATMAT2(A1,A2,A3)
9692 implicit real*8 (a-h,o-z)
9693 include 'DIMENSIONS'
9694 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9695 c DIMENSION AI3(2,2)
9699 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9705 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9706 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9707 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9708 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9716 c-------------------------------------------------------------------------
9717 double precision function scalar2(u,v)
9719 double precision u(2),v(2)
9722 scalar2=u(1)*v(1)+u(2)*v(2)
9726 C-----------------------------------------------------------------------------
9728 subroutine transpose2(a,at)
9730 double precision a(2,2),at(2,2)
9737 c--------------------------------------------------------------------------
9738 subroutine transpose(n,a,at)
9741 double precision a(n,n),at(n,n)
9749 C---------------------------------------------------------------------------
9750 subroutine prodmat3(a1,a2,kk,transp,prod)
9753 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9755 crc double precision auxmat(2,2),prod_(2,2)
9758 crc call transpose2(kk(1,1),auxmat(1,1))
9759 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9760 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9762 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9763 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9764 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9765 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9766 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9767 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9768 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9769 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9772 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9773 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9775 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9776 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9777 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9778 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9779 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9780 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9781 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9782 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9785 c call transpose2(a2(1,1),a2t(1,1))
9788 crc print *,((prod_(i,j),i=1,2),j=1,2)
9789 crc print *,((prod(i,j),i=1,2),j=1,2)
9793 C-----------------------------------------------------------------------------
9794 double precision function scalar(u,v)
9796 double precision u(3),v(3)
9806 C-----------------------------------------------------------------------
9807 double precision function sscale(r)
9808 double precision r,gamm
9809 include "COMMON.SPLITELE"
9810 if(r.lt.r_cut-rlamb) then
9812 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9813 gamm=(r-(r_cut-rlamb))/rlamb
9814 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9820 C-----------------------------------------------------------------------
9821 C-----------------------------------------------------------------------
9822 double precision function sscagrad(r)
9823 double precision r,gamm
9824 include "COMMON.SPLITELE"
9825 if(r.lt.r_cut-rlamb) then
9827 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9828 gamm=(r-(r_cut-rlamb))/rlamb
9829 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9835 C-----------------------------------------------------------------------
9836 C-----------------------------------------------------------------------
9837 double precision function sscalelip(r)
9838 double precision r,gamm
9839 include "COMMON.SPLITELE"
9840 C if(r.lt.r_cut-rlamb) then
9842 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9843 C gamm=(r-(r_cut-rlamb))/rlamb
9844 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9850 C-----------------------------------------------------------------------
9851 double precision function sscagradlip(r)
9852 double precision r,gamm
9853 include "COMMON.SPLITELE"
9854 C if(r.lt.r_cut-rlamb) then
9856 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9857 C gamm=(r-(r_cut-rlamb))/rlamb
9858 sscagradlip=r*(6*r-6.0d0)
9865 C-----------------------------------------------------------------------
9866 subroutine set_shield_fac
9867 implicit real*8 (a-h,o-z)
9868 include 'DIMENSIONS'
9869 include 'DIMENSIONS.ZSCOPT'
9870 include 'COMMON.CHAIN'
9871 include 'COMMON.DERIV'
9872 include 'COMMON.IOUNITS'
9873 include 'COMMON.SHIELD'
9874 include 'COMMON.INTERACT'
9875 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9876 double precision div77_81/0.974996043d0/,
9877 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9879 C the vector between center of side_chain and peptide group
9880 double precision pep_side(3),long,side_calf(3),
9881 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9882 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9883 C the line belowe needs to be changed for FGPROC>1
9885 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9887 Cif there two consequtive dummy atoms there is no peptide group between them
9888 C the line below has to be changed for FGPROC>1
9891 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9895 C first lets set vector conecting the ithe side-chain with kth side-chain
9896 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9898 C and vector conecting the side-chain with its proper calfa
9899 side_calf(j)=c(j,k+nres)-c(j,k)
9900 C side_calf(j)=2.0d0
9901 pept_group(j)=c(j,i)-c(j,i+1)
9902 C lets have their lenght
9903 dist_pep_side=pep_side(j)**2+dist_pep_side
9904 dist_side_calf=dist_side_calf+side_calf(j)**2
9905 dist_pept_group=dist_pept_group+pept_group(j)**2
9907 dist_pep_side=dsqrt(dist_pep_side)
9908 dist_pept_group=dsqrt(dist_pept_group)
9909 dist_side_calf=dsqrt(dist_side_calf)
9911 pep_side_norm(j)=pep_side(j)/dist_pep_side
9912 side_calf_norm(j)=dist_side_calf
9914 C now sscale fraction
9915 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9916 C print *,buff_shield,"buff"
9918 if (sh_frac_dist.le.0.0) cycle
9919 C If we reach here it means that this side chain reaches the shielding sphere
9920 C Lets add him to the list for gradient
9921 ishield_list(i)=ishield_list(i)+1
9922 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9923 C this list is essential otherwise problem would be O3
9924 shield_list(ishield_list(i),i)=k
9925 C Lets have the sscale value
9926 if (sh_frac_dist.gt.1.0) then
9927 scale_fac_dist=1.0d0
9929 sh_frac_dist_grad(j)=0.0d0
9932 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9933 & *(2.0*sh_frac_dist-3.0d0)
9934 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9935 & /dist_pep_side/buff_shield*0.5
9936 C remember for the final gradient multiply sh_frac_dist_grad(j)
9937 C for side_chain by factor -2 !
9939 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9940 C print *,"jestem",scale_fac_dist,fac_help_scale,
9941 C & sh_frac_dist_grad(j)
9944 C if ((i.eq.3).and.(k.eq.2)) then
9945 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9949 C this is what is now we have the distance scaling now volume...
9950 short=short_r_sidechain(itype(k))
9951 long=long_r_sidechain(itype(k))
9952 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9955 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9958 costhet_grad(j)=costhet_fac*pep_side(j)
9960 C remember for the final gradient multiply costhet_grad(j)
9961 C for side_chain by factor -2 !
9962 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9963 C pep_side0pept_group is vector multiplication
9964 pep_side0pept_group=0.0
9966 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9968 cosalfa=(pep_side0pept_group/
9969 & (dist_pep_side*dist_side_calf))
9970 fac_alfa_sin=1.0-cosalfa**2
9971 fac_alfa_sin=dsqrt(fac_alfa_sin)
9972 rkprim=fac_alfa_sin*(long-short)+short
9974 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9975 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9978 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9979 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9980 &*(long-short)/fac_alfa_sin*cosalfa/
9981 &((dist_pep_side*dist_side_calf))*
9982 &((side_calf(j))-cosalfa*
9983 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9985 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9986 &*(long-short)/fac_alfa_sin*cosalfa
9987 &/((dist_pep_side*dist_side_calf))*
9989 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9992 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9995 C now the gradient...
9996 C grad_shield is gradient of Calfa for peptide groups
9997 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9999 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
10000 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
10002 grad_shield(j,i)=grad_shield(j,i)
10003 C gradient po skalowaniu
10004 & +(sh_frac_dist_grad(j)
10005 C gradient po costhet
10006 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10007 &-scale_fac_dist*(cosphi_grad_long(j))
10008 &/(1.0-cosphi) )*div77_81
10010 C grad_shield_side is Cbeta sidechain gradient
10011 grad_shield_side(j,ishield_list(i),i)=
10012 & (sh_frac_dist_grad(j)*(-2.0d0)
10013 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10014 & +scale_fac_dist*(cosphi_grad_long(j))
10015 & *2.0d0/(1.0-cosphi))
10016 & *div77_81*VofOverlap
10018 grad_shield_loc(j,ishield_list(i),i)=
10019 & scale_fac_dist*cosphi_grad_loc(j)
10020 & *2.0d0/(1.0-cosphi)
10021 & *div77_81*VofOverlap
10023 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10025 fac_shield(i)=VolumeTotal*div77_81+div4_81
10026 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10030 C--------------------------------------------------------------------------
10031 C first for shielding is setting of function of side-chains
10032 subroutine set_shield_fac2
10033 implicit real*8 (a-h,o-z)
10034 include 'DIMENSIONS'
10035 include 'DIMENSIONS.ZSCOPT'
10036 include 'COMMON.CHAIN'
10037 include 'COMMON.DERIV'
10038 include 'COMMON.IOUNITS'
10039 include 'COMMON.SHIELD'
10040 include 'COMMON.INTERACT'
10041 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10042 double precision div77_81/0.974996043d0/,
10043 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10045 C the vector between center of side_chain and peptide group
10046 double precision pep_side(3),long,side_calf(3),
10047 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10048 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10049 C the line belowe needs to be changed for FGPROC>1
10051 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10053 Cif there two consequtive dummy atoms there is no peptide group between them
10054 C the line below has to be changed for FGPROC>1
10057 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10061 C first lets set vector conecting the ithe side-chain with kth side-chain
10062 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10063 C pep_side(j)=2.0d0
10064 C and vector conecting the side-chain with its proper calfa
10065 side_calf(j)=c(j,k+nres)-c(j,k)
10066 C side_calf(j)=2.0d0
10067 pept_group(j)=c(j,i)-c(j,i+1)
10068 C lets have their lenght
10069 dist_pep_side=pep_side(j)**2+dist_pep_side
10070 dist_side_calf=dist_side_calf+side_calf(j)**2
10071 dist_pept_group=dist_pept_group+pept_group(j)**2
10073 dist_pep_side=dsqrt(dist_pep_side)
10074 dist_pept_group=dsqrt(dist_pept_group)
10075 dist_side_calf=dsqrt(dist_side_calf)
10077 pep_side_norm(j)=pep_side(j)/dist_pep_side
10078 side_calf_norm(j)=dist_side_calf
10080 C now sscale fraction
10081 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10082 C print *,buff_shield,"buff"
10084 if (sh_frac_dist.le.0.0) cycle
10085 C If we reach here it means that this side chain reaches the shielding sphere
10086 C Lets add him to the list for gradient
10087 ishield_list(i)=ishield_list(i)+1
10088 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10089 C this list is essential otherwise problem would be O3
10090 shield_list(ishield_list(i),i)=k
10091 C Lets have the sscale value
10092 if (sh_frac_dist.gt.1.0) then
10093 scale_fac_dist=1.0d0
10095 sh_frac_dist_grad(j)=0.0d0
10098 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10099 & *(2.0d0*sh_frac_dist-3.0d0)
10100 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
10101 & /dist_pep_side/buff_shield*0.5d0
10102 C remember for the final gradient multiply sh_frac_dist_grad(j)
10103 C for side_chain by factor -2 !
10105 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10106 C sh_frac_dist_grad(j)=0.0d0
10107 C scale_fac_dist=1.0d0
10108 C print *,"jestem",scale_fac_dist,fac_help_scale,
10109 C & sh_frac_dist_grad(j)
10112 C this is what is now we have the distance scaling now volume...
10113 short=short_r_sidechain(itype(k))
10114 long=long_r_sidechain(itype(k))
10115 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
10116 sinthet=short/dist_pep_side*costhet
10120 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
10121 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
10122 C & -short/dist_pep_side**2/costhet)
10123 C costhet_fac=0.0d0
10125 costhet_grad(j)=costhet_fac*pep_side(j)
10127 C remember for the final gradient multiply costhet_grad(j)
10128 C for side_chain by factor -2 !
10129 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10130 C pep_side0pept_group is vector multiplication
10131 pep_side0pept_group=0.0d0
10133 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10135 cosalfa=(pep_side0pept_group/
10136 & (dist_pep_side*dist_side_calf))
10137 fac_alfa_sin=1.0d0-cosalfa**2
10138 fac_alfa_sin=dsqrt(fac_alfa_sin)
10139 rkprim=fac_alfa_sin*(long-short)+short
10143 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
10145 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
10146 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
10147 & dist_pep_side**2)
10150 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10151 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10152 &*(long-short)/fac_alfa_sin*cosalfa/
10153 &((dist_pep_side*dist_side_calf))*
10154 &((side_calf(j))-cosalfa*
10155 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10156 C cosphi_grad_long(j)=0.0d0
10157 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10158 &*(long-short)/fac_alfa_sin*cosalfa
10159 &/((dist_pep_side*dist_side_calf))*
10161 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10162 C cosphi_grad_loc(j)=0.0d0
10164 C print *,sinphi,sinthet
10165 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
10168 C now the gradient...
10170 grad_shield(j,i)=grad_shield(j,i)
10171 C gradient po skalowaniu
10172 & +(sh_frac_dist_grad(j)*VofOverlap
10173 C gradient po costhet
10174 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
10175 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10176 & sinphi/sinthet*costhet*costhet_grad(j)
10177 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10179 C grad_shield_side is Cbeta sidechain gradient
10180 grad_shield_side(j,ishield_list(i),i)=
10181 & (sh_frac_dist_grad(j)*(-2.0d0)
10183 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10184 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10185 & sinphi/sinthet*costhet*costhet_grad(j)
10186 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10189 grad_shield_loc(j,ishield_list(i),i)=
10190 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10191 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
10192 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
10196 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10198 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
10199 c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i),
10200 c & " wshield",wshield
10201 c write(2,*) "TU",rpp(1,1),short,long,buff_shield
10205 C--------------------------------------------------------------------------
10206 double precision function tschebyshev(m,n,x,y)
10208 include "DIMENSIONS"
10210 double precision x(n),y,yy(0:maxvar),aux
10211 c Tschebyshev polynomial. Note that the first term is omitted
10212 c m=0: the constant term is included
10213 c m=1: the constant term is not included
10217 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
10226 C--------------------------------------------------------------------------
10227 double precision function gradtschebyshev(m,n,x,y)
10229 include "DIMENSIONS"
10231 double precision x(n+1),y,yy(0:maxvar),aux
10232 c Tschebyshev polynomial. Note that the first term is omitted
10233 c m=0: the constant term is included
10234 c m=1: the constant term is not included
10238 yy(i)=2*y*yy(i-1)-yy(i-2)
10242 aux=aux+x(i+1)*yy(i)*(i+1)
10243 C print *, x(i+1),yy(i),i
10245 gradtschebyshev=aux
10248 c----------------------------------------------------------------------------
10249 double precision function sscale2(r,r_cut,r0,rlamb)
10251 double precision r,gamm,r_cut,r0,rlamb,rr
10253 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
10254 c write (2,*) "rr",rr
10255 if(rr.lt.r_cut-rlamb) then
10257 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10258 gamm=(rr-(r_cut-rlamb))/rlamb
10259 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10265 C-----------------------------------------------------------------------
10266 double precision function sscalgrad2(r,r_cut,r0,rlamb)
10268 double precision r,gamm,r_cut,r0,rlamb,rr
10270 if(rr.lt.r_cut-rlamb) then
10272 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10273 gamm=(rr-(r_cut-rlamb))/rlamb
10275 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
10277 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
10284 c----------------------------------------------------------------------------
10285 subroutine e_saxs(Esaxs_constr)
10287 include 'DIMENSIONS'
10288 include 'DIMENSIONS.ZSCOPT'
10289 include 'DIMENSIONS.FREE'
10292 include "COMMON.SETUP"
10295 include 'COMMON.SBRIDGE'
10296 include 'COMMON.CHAIN'
10297 include 'COMMON.GEO'
10298 include 'COMMON.LOCAL'
10299 include 'COMMON.INTERACT'
10300 include 'COMMON.VAR'
10301 include 'COMMON.IOUNITS'
10302 include 'COMMON.DERIV'
10303 include 'COMMON.CONTROL'
10304 include 'COMMON.NAMES'
10305 include 'COMMON.FFIELD'
10306 include 'COMMON.LANGEVIN'
10307 include 'COMMON.SAXS'
10309 double precision Esaxs_constr
10310 integer i,iint,j,k,l
10311 double precision PgradC(maxSAXS,3,maxres),
10312 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
10314 double precision PgradC_(maxSAXS,3,maxres),
10315 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
10317 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
10318 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
10319 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
10320 & auxX,auxX1,CACAgrad,Cnorm
10321 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
10322 double precision dist
10324 c SAXS restraint penalty function
10326 write(iout,*) "------- SAXS penalty function start -------"
10327 write (iout,*) "nsaxs",nsaxs
10328 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
10329 write (iout,*) "Psaxs"
10331 write (iout,'(i5,e15.5)') i, Psaxs(i)
10334 Esaxs_constr = 0.0d0
10339 PgradC(k,l,j)=0.0d0
10340 PgradX(k,l,j)=0.0d0
10344 do i=iatsc_s,iatsc_e
10345 if (itype(i).eq.ntyp1) cycle
10346 do iint=1,nint_gr(i)
10347 do j=istart(i,iint),iend(i,iint)
10348 if (itype(j).eq.ntyp1) cycle
10351 dijCASC=dist(i,j+nres)
10352 dijSCCA=dist(i+nres,j)
10353 dijSCSC=dist(i+nres,j+nres)
10354 sigma2CACA=2.0d0/(pstok**2)
10355 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
10356 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
10357 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
10360 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10361 if (itype(j).ne.10) then
10362 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
10366 if (itype(i).ne.10) then
10367 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
10371 if (itype(i).ne.10 .and. itype(j).ne.10) then
10372 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
10376 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
10378 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10380 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10381 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
10382 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
10383 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
10386 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10387 PgradC(k,l,i) = PgradC(k,l,i)-aux
10388 PgradC(k,l,j) = PgradC(k,l,j)+aux
10390 if (itype(j).ne.10) then
10391 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
10392 PgradC(k,l,i) = PgradC(k,l,i)-aux
10393 PgradC(k,l,j) = PgradC(k,l,j)+aux
10394 PgradX(k,l,j) = PgradX(k,l,j)+aux
10397 if (itype(i).ne.10) then
10398 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
10399 PgradX(k,l,i) = PgradX(k,l,i)-aux
10400 PgradC(k,l,i) = PgradC(k,l,i)-aux
10401 PgradC(k,l,j) = PgradC(k,l,j)+aux
10404 if (itype(i).ne.10 .and. itype(j).ne.10) then
10405 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
10406 PgradC(k,l,i) = PgradC(k,l,i)-aux
10407 PgradC(k,l,j) = PgradC(k,l,j)+aux
10408 PgradX(k,l,i) = PgradX(k,l,i)-aux
10409 PgradX(k,l,j) = PgradX(k,l,j)+aux
10415 sigma2CACA=scal_rad**2*0.25d0/
10416 & (restok(itype(j))**2+restok(itype(i))**2)
10418 IF (saxs_cutoff.eq.0) THEN
10421 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10422 Pcalc(k) = Pcalc(k)+expCACA
10423 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10425 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10426 PgradC(k,l,i) = PgradC(k,l,i)-aux
10427 PgradC(k,l,j) = PgradC(k,l,j)+aux
10431 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
10434 c write (2,*) "ijk",i,j,k
10435 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
10436 if (sss2.eq.0.0d0) cycle
10437 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
10438 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
10439 Pcalc(k) = Pcalc(k)+expCACA
10441 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10443 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
10444 & ssgrad2*expCACA/sss2
10447 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10448 PgradC(k,l,i) = PgradC(k,l,i)+aux
10449 PgradC(k,l,j) = PgradC(k,l,j)-aux
10458 if (nfgtasks.gt.1) then
10459 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
10460 & MPI_SUM,king,FG_COMM,IERR)
10461 if (fg_rank.eq.king) then
10463 Pcalc(k) = Pcalc_(k)
10466 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
10467 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10468 if (fg_rank.eq.king) then
10472 PgradC(k,l,i) = PgradC_(k,l,i)
10478 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
10479 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10480 if (fg_rank.eq.king) then
10484 PgradX(k,l,i) = PgradX_(k,l,i)
10493 if (fg_rank.eq.king) then
10497 Cnorm = Cnorm + Pcalc(k)
10499 Esaxs_constr = dlog(Cnorm)-wsaxs0
10501 if (Pcalc(k).gt.0.0d0)
10502 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
10504 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
10508 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
10518 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
10519 auxC1 = auxC1+PgradC(k,l,i)
10521 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
10522 auxX1 = auxX1+PgradX(k,l,i)
10525 gsaxsC(l,i) = auxC - auxC1/Cnorm
10527 gsaxsX(l,i) = auxX - auxX1/Cnorm
10529 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
10530 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
10538 c----------------------------------------------------------------------------
10539 subroutine e_saxsC(Esaxs_constr)
10541 include 'DIMENSIONS'
10542 include 'DIMENSIONS.ZSCOPT'
10543 include 'DIMENSIONS.FREE'
10546 include "COMMON.SETUP"
10549 include 'COMMON.SBRIDGE'
10550 include 'COMMON.CHAIN'
10551 include 'COMMON.GEO'
10552 include 'COMMON.LOCAL'
10553 include 'COMMON.INTERACT'
10554 include 'COMMON.VAR'
10555 include 'COMMON.IOUNITS'
10556 include 'COMMON.DERIV'
10557 include 'COMMON.CONTROL'
10558 include 'COMMON.NAMES'
10559 include 'COMMON.FFIELD'
10560 include 'COMMON.LANGEVIN'
10561 include 'COMMON.SAXS'
10563 double precision Esaxs_constr
10564 integer i,iint,j,k,l
10565 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
10567 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
10569 double precision dk,dijCASPH,dijSCSPH,
10570 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
10571 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10573 c SAXS restraint penalty function
10575 write(iout,*) "------- SAXS penalty function start -------"
10576 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10577 & " isaxs_end",isaxs_end
10578 write (iout,*) "nnt",nnt," ntc",nct
10580 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10581 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10584 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10587 Esaxs_constr = 0.0d0
10589 do j=isaxs_start,isaxs_end
10601 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10603 if (itype(i).ne.10) then
10605 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10608 sigma2CA=2.0d0/pstok**2
10609 sigma2SC=4.0d0/restok(itype(i))**2
10610 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10611 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10612 Pcalc = Pcalc+expCASPH+expSCSPH
10614 write(*,*) "processor i j Pcalc",
10615 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
10617 CASPHgrad = sigma2CA*expCASPH
10618 SCSPHgrad = sigma2SC*expSCSPH
10620 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10621 PgradX(l,i) = PgradX(l,i) + aux
10622 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10627 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
10628 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
10631 logPtot = logPtot - dlog(Pcalc)
10632 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
10633 c & " logPtot",logPtot
10636 if (nfgtasks.gt.1) then
10637 c write (iout,*) "logPtot before reduction",logPtot
10638 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10639 & MPI_SUM,king,FG_COMM,IERR)
10641 c write (iout,*) "logPtot after reduction",logPtot
10642 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10643 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10644 if (fg_rank.eq.king) then
10647 gsaxsC(l,i) = gsaxsC_(l,i)
10651 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10652 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10653 if (fg_rank.eq.king) then
10656 gsaxsX(l,i) = gsaxsX_(l,i)
10662 Esaxs_constr = logPtot