1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
9 cMS$ATTRIBUTES C :: proc_proc
12 include 'COMMON.IOUNITS'
13 double precision energia(0:max_ene),energia1(0:max_ene+1)
14 include 'COMMON.FFIELD'
15 include 'COMMON.DERIV'
16 include 'COMMON.INTERACT'
17 include 'COMMON.SBRIDGE'
18 include 'COMMON.CHAIN'
19 include 'COMMON.SHIELD'
20 include 'COMMON.CONTROL'
21 include 'COMMON.TORCNSTR'
23 double precision fact(6)
24 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
26 cd print *,'nnt=',nnt,' nct=',nct
28 C Compute the side-chain and electrostatic interaction energy
30 goto (101,102,103,104,105) ipot
31 C Lennard-Jones potential.
32 101 call elj(evdw,evdw_t)
33 cd print '(a)','Exit ELJ'
35 C Lennard-Jones-Kihara potential (shifted).
36 102 call eljk(evdw,evdw_t)
38 C Berne-Pechukas potential (dilated LJ, angular dependence).
39 103 call ebp(evdw,evdw_t)
41 C Gay-Berne potential (shifted LJ, angular dependence).
42 104 call egb(evdw,evdw_t)
44 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
45 105 call egbv(evdw,evdw_t)
47 C Calculate electrostatic (H-bonding) energy of the main chain.
50 c write (iout,*) "Sidechain"
53 if (shield_mode.eq.1) then
55 else if (shield_mode.eq.2) then
58 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
59 c write(iout,*) 'po eelec'
62 C Calculate excluded-volume interaction energy between peptide groups
65 call escp(evdw2,evdw2_14)
67 c Calculate the bond-stretching energy
71 C write (iout,*) "estr",estr
73 C Calculate the disulfide-bridge and other energy and the contributions
74 C from other distance constraints.
75 cd print *,'Calling EHPB'
77 cd print *,'EHPB exitted succesfully.'
79 C Calculate the virtual-bond-angle energy.
81 C print *,'Bend energy finished.'
83 if (tor_mode.eq.0) then
86 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
94 if (with_theta_constr) call etheta_constr(ethetacnstr)
95 c call ebend(ebe,ethetacnstr)
96 cd print *,'Bend energy finished.'
98 C Calculate the SC local energy.
101 C print *,'SCLOC energy finished.'
103 C Calculate the virtual-bond torsional energy.
105 if (wtor.gt.0.0d0) then
106 if (tor_mode.eq.0) then
107 call etor(etors,fact(1))
109 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
111 call etor_kcc(etors,fact(1))
117 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
118 c print *,"Processor",myrank," computed Utor"
120 C 6/23/01 Calculate double-torsional energy
122 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
123 call etor_d(etors_d,fact(2))
127 c print *,"Processor",myrank," computed Utord"
129 if (wsccor.gt.0.0d0) then
130 call eback_sc_corr(esccor)
135 if (wliptran.gt.0) then
136 call Eliptransfer(eliptran)
142 C 12/1/95 Multi-body terms
146 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
147 & .or. wturn6.gt.0.0d0) then
148 c write(iout,*)"calling multibody_eello"
149 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
150 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
151 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
158 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
159 c write (iout,*) "Calling multibody_hbond"
160 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
163 c write (iout,*) "NSAXS",nsaxs
164 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
165 call e_saxs(Esaxs_constr)
166 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
167 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
168 call e_saxsC(Esaxs_constr)
169 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
173 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
174 if (constr_homology.ge.1) then
175 call e_modeller(ehomology_constr)
177 ehomology_constr=0.0d0
180 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
182 C BARTEK for dfa test!
184 if (wdfa_dist.gt.0) call edfad(edfadis)
185 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
187 if (wdfa_tor.gt.0) call edfat(edfator)
188 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
190 if (wdfa_nei.gt.0) call edfan(edfanei)
191 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
193 if (wdfa_beta.gt.0) call edfab(edfabet)
194 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
203 if (shield_mode.gt.0) then
204 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
206 & +fact(1)*wvdwpp*evdw1
207 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
209 & +wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
210 & +wcorr6*fact(5)*ecorr6
211 & +wturn4*fact(3)*eello_turn4
212 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
213 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
214 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
215 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
216 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
219 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
221 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
222 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
223 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
224 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
225 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
226 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
227 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
228 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
232 if (shield_mode.gt.0) then
233 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
234 & +welec*fact(1)*(ees+evdw1)
235 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
236 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
237 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
238 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
239 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
240 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
241 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
242 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
245 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
246 & +welec*fact(1)*(ees+evdw1)
247 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
248 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
249 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
250 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
251 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
252 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
253 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
254 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
261 energia(2)=evdw2-evdw2_14
278 energia(8)=eello_turn3
279 energia(9)=eello_turn4
288 energia(20)=edihcnstr
291 energia(24)=ethetacnstr
292 energia(26)=esaxs_constr
293 energia(27)=ehomology_constr
301 if (isnan(etot).ne.0) energia(0)=1.0d+99
303 if (isnan(etot)) energia(0)=1.0d+99
308 idumm=proc_proc(etot,i)
310 call proc_proc(etot,i)
312 if(i.eq.1)energia(0)=1.0d+99
318 call enerprint(energia,fact)
322 C Sum up the components of the Cartesian gradient.
327 if (shield_mode.eq.0) then
328 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
329 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
331 & wstrain*ghpbc(j,i)+
332 & wcorr*fact(3)*gradcorr(j,i)+
333 & wel_loc*fact(2)*gel_loc(j,i)+
334 & wturn3*fact(2)*gcorr3_turn(j,i)+
335 & wturn4*fact(3)*gcorr4_turn(j,i)+
336 & wcorr5*fact(4)*gradcorr5(j,i)+
337 & wcorr6*fact(5)*gradcorr6(j,i)+
338 & wturn6*fact(5)*gcorr6_turn(j,i)+
339 & wsccor*fact(2)*gsccorc(j,i)
340 & +wliptran*gliptranc(j,i)+
341 & wdfa_dist*gdfad(j,i)+
342 & wdfa_tor*gdfat(j,i)+
343 & wdfa_nei*gdfan(j,i)+
344 & wdfa_beta*gdfab(j,i)
345 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
347 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
348 & wsccor*fact(2)*gsccorx(j,i)
349 & +wliptran*gliptranx(j,i)
351 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
352 & +fact(1)*wscp*gvdwc_scp(j,i)+
353 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
355 & wstrain*ghpbc(j,i)+
356 & wcorr*fact(3)*gradcorr(j,i)+
357 & wel_loc*fact(2)*gel_loc(j,i)+
358 & wturn3*fact(2)*gcorr3_turn(j,i)+
359 & wturn4*fact(3)*gcorr4_turn(j,i)+
360 & wcorr5*fact(4)*gradcorr5(j,i)+
361 & wcorr6*fact(5)*gradcorr6(j,i)+
362 & wturn6*fact(5)*gcorr6_turn(j,i)+
363 & wsccor*fact(2)*gsccorc(j,i)
364 & +wliptran*gliptranc(j,i)
365 & +welec*gshieldc(j,i)
366 & +welec*gshieldc_loc(j,i)
367 & +wcorr*gshieldc_ec(j,i)
368 & +wcorr*gshieldc_loc_ec(j,i)
369 & +wturn3*gshieldc_t3(j,i)
370 & +wturn3*gshieldc_loc_t3(j,i)
371 & +wturn4*gshieldc_t4(j,i)
372 & +wturn4*gshieldc_loc_t4(j,i)
373 & +wel_loc*gshieldc_ll(j,i)
374 & +wel_loc*gshieldc_loc_ll(j,i)+
375 & wdfa_dist*gdfad(j,i)+
376 & wdfa_tor*gdfat(j,i)+
377 & wdfa_nei*gdfan(j,i)+
378 & wdfa_beta*gdfab(j,i)
379 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
380 & +fact(1)*wscp*gradx_scp(j,i)+
382 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
383 & wsccor*fact(2)*gsccorx(j,i)
384 & +wliptran*gliptranx(j,i)
385 & +welec*gshieldx(j,i)
386 & +wcorr*gshieldx_ec(j,i)
387 & +wturn3*gshieldx_t3(j,i)
388 & +wturn4*gshieldx_t4(j,i)
389 & +wel_loc*gshieldx_ll(j,i)
397 if (shield_mode.eq.0) then
398 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
399 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
401 & wcorr*fact(3)*gradcorr(j,i)+
402 & wel_loc*fact(2)*gel_loc(j,i)+
403 & wturn3*fact(2)*gcorr3_turn(j,i)+
404 & wturn4*fact(3)*gcorr4_turn(j,i)+
405 & wcorr5*fact(4)*gradcorr5(j,i)+
406 & wcorr6*fact(5)*gradcorr6(j,i)+
407 & wturn6*fact(5)*gcorr6_turn(j,i)+
408 & wsccor*fact(2)*gsccorc(j,i)
409 & +wliptran*gliptranc(j,i)+
410 & wdfa_dist*gdfad(j,i)+
411 & wdfa_tor*gdfat(j,i)+
412 & wdfa_nei*gdfan(j,i)+
413 & wdfa_beta*gdfab(j,i)
414 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
416 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
417 & wsccor*fact(1)*gsccorx(j,i)
418 & +wliptran*gliptranx(j,i)
420 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
421 & fact(1)*wscp*gvdwc_scp(j,i)+
422 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
424 & wcorr*fact(3)*gradcorr(j,i)+
425 & wel_loc*fact(2)*gel_loc(j,i)+
426 & wturn3*fact(2)*gcorr3_turn(j,i)+
427 & wturn4*fact(3)*gcorr4_turn(j,i)+
428 & wcorr5*fact(4)*gradcorr5(j,i)+
429 & wcorr6*fact(5)*gradcorr6(j,i)+
430 & wturn6*fact(5)*gcorr6_turn(j,i)+
431 & wsccor*fact(2)*gsccorc(j,i)
432 & +wliptran*gliptranc(j,i)
433 & +welec*gshieldc(j,i)
434 & +welec*gshieldc_loc(j,i)
435 & +wcorr*gshieldc_ec(j,i)
436 & +wcorr*gshieldc_loc_ec(j,i)
437 & +wturn3*gshieldc_t3(j,i)
438 & +wturn3*gshieldc_loc_t3(j,i)
439 & +wturn4*gshieldc_t4(j,i)
440 & +wturn4*gshieldc_loc_t4(j,i)
441 & +wel_loc*gshieldc_ll(j,i)
442 & +wel_loc*gshieldc_loc_ll(j,i)+
443 & wdfa_dist*gdfad(j,i)+
444 & wdfa_tor*gdfat(j,i)+
445 & wdfa_nei*gdfan(j,i)+
446 & wdfa_beta*gdfab(j,i)
447 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
448 & fact(1)*wscp*gradx_scp(j,i)+
450 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
451 & wsccor*fact(1)*gsccorx(j,i)
452 & +wliptran*gliptranx(j,i)
453 & +welec*gshieldx(j,i)
454 & +wcorr*gshieldx_ec(j,i)
455 & +wturn3*gshieldx_t3(j,i)
456 & +wturn4*gshieldx_t4(j,i)
457 & +wel_loc*gshieldx_ll(j,i)
465 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
466 & +wcorr5*fact(4)*g_corr5_loc(i)
467 & +wcorr6*fact(5)*g_corr6_loc(i)
468 & +wturn4*fact(3)*gel_loc_turn4(i)
469 & +wturn3*fact(2)*gel_loc_turn3(i)
470 & +wturn6*fact(5)*gel_loc_turn6(i)
471 & +wel_loc*fact(2)*gel_loc_loc(i)
472 c & +wsccor*fact(1)*gsccor_loc(i)
473 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
476 if (dyn_ss) call dyn_set_nss
479 C------------------------------------------------------------------------
480 subroutine enerprint(energia,fact)
481 implicit real*8 (a-h,o-z)
483 include 'COMMON.IOUNITS'
484 include 'COMMON.FFIELD'
485 include 'COMMON.SBRIDGE'
486 include 'COMMON.CONTROL'
487 double precision energia(0:max_ene),fact(6)
489 evdw=energia(1)+fact(6)*energia(21)
491 evdw2=energia(2)+energia(17)
503 eello_turn3=energia(8)
504 eello_turn4=energia(9)
505 eello_turn6=energia(10)
512 edihcnstr=energia(20)
514 ethetacnstr=energia(24)
517 ehomology_constr=energia(27)
519 edfadis = energia(28)
520 edfator = energia(29)
521 edfanei = energia(30)
522 edfabet = energia(31)
527 write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
528 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
529 & etors_d,wtor_d*fact(2),ehpb,wstrain,
531 & ecorr,wcorr*fact(3),
532 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
535 & wel_loc*fact(2),eello_turn3,wturn3*fact(2),
536 & eello_turn4,wturn4*fact(3),
538 & eello_turn6,wturn6*fact(5),
540 & esccor,wsccor*fact(1),edihcnstr,
541 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
542 & etube,wtube,esaxs,wsaxs,ehomology_constr,
543 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
546 10 format (/'Virtual-chain energies:'//
547 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
548 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
549 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
550 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
551 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
552 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
553 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
554 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
555 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
556 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
557 & ' (SS bridges & dist. cnstr.)'/
559 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
560 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
561 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
563 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
564 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
565 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
567 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
569 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
570 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
571 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
572 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
573 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
574 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
575 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
576 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
577 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
578 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
579 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
580 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
581 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
582 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
583 & 'ETOT= ',1pE16.6,' (total)')
586 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
587 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
588 & etors_d,wtor_d*fact(2),ehpb,
590 & wstrain,ecorr,wcorr*fact(3),
591 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
593 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
594 & eello_turn4,wturn4*fact(3),
596 & eello_turn6,wturn6*fact(5),
598 & esccor,wsccor*fact(1),edihcnstr,
599 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
600 & etube,wtube,esaxs,wsaxs,ehomology_constr,
601 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
604 10 format (/'Virtual-chain energies:'//
605 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
606 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
607 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
608 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
609 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
610 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
611 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
612 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
613 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
614 & ' (SS bridges & dist. restr.)'/
616 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
617 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
618 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
620 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
621 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
622 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
624 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
626 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
627 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
628 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
629 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
630 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
631 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
632 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
633 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
634 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
635 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
636 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
637 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
638 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
639 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
640 & 'ETOT= ',1pE16.6,' (total)')
644 C-----------------------------------------------------------------------
645 subroutine elj(evdw,evdw_t)
647 C This subroutine calculates the interaction energy of nonbonded side chains
648 C assuming the LJ potential of interaction.
650 implicit real*8 (a-h,o-z)
652 include "DIMENSIONS.COMPAR"
653 parameter (accur=1.0d-10)
656 include 'COMMON.LOCAL'
657 include 'COMMON.CHAIN'
658 include 'COMMON.DERIV'
659 include 'COMMON.INTERACT'
660 include 'COMMON.TORSION'
661 include 'COMMON.SBRIDGE'
662 include 'COMMON.NAMES'
663 include 'COMMON.IOUNITS'
665 include 'COMMON.CONTACTS'
666 include 'COMMON.CONTMAT'
671 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
675 c eneps_temp(j,i)=0.0d0
684 if (itypi.eq.ntyp1) cycle
685 itypi1=iabs(itype(i+1))
689 call to_box(xi,yi,zi)
693 C Calculate SC interaction energy.
696 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
697 cd & 'iend=',iend(i,iint)
698 do j=istart(i,iint),iend(i,iint)
700 if (itypj.eq.ntyp1) cycle
704 call to_box(xj,yj,zj)
705 xj=boxshift(xj-xi,boxxsize)
706 yj=boxshift(yj-yi,boxysize)
707 zj=boxshift(zj-zi,boxzsize)
708 C Change 12/1/95 to calculate four-body interactions
709 rij=xj*xj+yj*yj+zj*zj
713 if (sss1.eq.0.0d0) cycle
714 sssgrad1=sscagrad(sqrij)
715 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
716 eps0ij=eps(itypi,itypj)
721 ij=icant(itypi,itypj)
723 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
724 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
727 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
728 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
729 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
730 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
731 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
732 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
733 if (bb.gt.0.0d0) then
734 evdw=evdw+sss1*evdwij
736 evdw_t=evdw_t+sss1*evdwij
740 C Calculate the components of the gradient in DC and X
742 fac=-rrij*(e1+evdwij)*sss1
743 & +evdwij*sssgrad1/sqrij/expon
748 gvdwx(k,i)=gvdwx(k,i)-gg(k)
749 gvdwx(k,j)=gvdwx(k,j)+gg(k)
753 gvdwc(l,k)=gvdwc(l,k)+gg(l)
759 C 12/1/95, revised on 5/20/97
761 C Calculate the contact function. The ith column of the array JCONT will
762 C contain the numbers of atoms that make contacts with the atom I (of numbers
763 C greater than I). The arrays FACONT and GACONT will contain the values of
764 C the contact function and its derivative.
766 C Uncomment next line, if the correlation interactions include EVDW explicitly.
767 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
768 C Uncomment next line, if the correlation interactions are contact function only
769 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
771 sigij=sigma(itypi,itypj)
772 r0ij=rs0(itypi,itypj)
774 C Check whether the SC's are not too far to make a contact.
777 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
778 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
780 if (fcont.gt.0.0D0) then
781 C If the SC-SC distance if close to sigma, apply spline.
782 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
783 cAdam & fcont1,fprimcont1)
784 cAdam fcont1=1.0d0-fcont1
785 cAdam if (fcont1.gt.0.0d0) then
786 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
787 cAdam fcont=fcont*fcont1
789 C Uncomment following 4 lines to have the geometric average of the epsilon0's
790 cga eps0ij=1.0d0/dsqrt(eps0ij)
792 cga gg(k)=gg(k)*eps0ij
794 cga eps0ij=-evdwij*eps0ij
795 C Uncomment for AL's type of SC correlation interactions.
797 num_conti=num_conti+1
799 facont(num_conti,i)=fcont*eps0ij
800 fprimcont=eps0ij*fprimcont/rij
802 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
803 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
804 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
805 C Uncomment following 3 lines for Skolnick's type of SC correlation.
806 gacont(1,num_conti,i)=-fprimcont*xj
807 gacont(2,num_conti,i)=-fprimcont*yj
808 gacont(3,num_conti,i)=-fprimcont*zj
809 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
810 cd write (iout,'(2i3,3f10.5)')
811 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
819 num_cont(i)=num_conti
825 gvdwc(j,i)=expon*gvdwc(j,i)
826 gvdwx(j,i)=expon*gvdwx(j,i)
830 C******************************************************************************
834 C To save time, the factor of EXPON has been extracted from ALL components
835 C of GVDWC and GRADX. Remember to multiply them by this factor before further
838 C******************************************************************************
841 C-----------------------------------------------------------------------------
842 subroutine eljk(evdw,evdw_t)
844 C This subroutine calculates the interaction energy of nonbonded side chains
845 C assuming the LJK potential of interaction.
847 implicit real*8 (a-h,o-z)
849 include "DIMENSIONS.COMPAR"
852 include 'COMMON.LOCAL'
853 include 'COMMON.CHAIN'
854 include 'COMMON.DERIV'
855 include 'COMMON.INTERACT'
856 include 'COMMON.IOUNITS'
857 include 'COMMON.NAMES'
862 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
865 c eneps_temp(j,i)=0.0d0
872 if (itypi.eq.ntyp1) cycle
873 itypi1=iabs(itype(i+1))
877 call to_box(xi,yi,zi)
879 C Calculate SC interaction energy.
882 do j=istart(i,iint),iend(i,iint)
884 if (itypj.eq.ntyp1) cycle
888 call to_box(xj,yj,zj)
889 xj=boxshift(xj-xi,boxxsize)
890 yj=boxshift(yj-yi,boxysize)
891 zj=boxshift(zj-zi,boxzsize)
892 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
894 e_augm=augm(itypi,itypj)*fac_augm
898 if (sss1.eq.0.0d0) cycle
899 sssgrad1=sscagrad(rij)
900 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
901 fac=r_shift_inv**expon
905 ij=icant(itypi,itypj)
906 c eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
907 c & /dabs(eps(itypi,itypj))
908 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
909 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
910 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
911 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
912 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
913 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
914 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
915 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
916 if (bb.gt.0.0d0) then
917 evdw=evdw+evdwij*sss1
919 evdw_t=evdw_t+evdwij*sss1
923 C Calculate the components of the gradient in DC and X
925 fac=(-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2))*sss1
926 & +evdwij*sssgrad1*r_inv_ij/expon
931 gvdwx(k,i)=gvdwx(k,i)-gg(k)
932 gvdwx(k,j)=gvdwx(k,j)+gg(k)
936 gvdwc(l,k)=gvdwc(l,k)+gg(l)
946 gvdwc(j,i)=expon*gvdwc(j,i)
947 gvdwx(j,i)=expon*gvdwx(j,i)
953 C-----------------------------------------------------------------------------
954 subroutine ebp(evdw,evdw_t)
956 C This subroutine calculates the interaction energy of nonbonded side chains
957 C assuming the Berne-Pechukas potential of interaction.
959 implicit real*8 (a-h,o-z)
961 include "DIMENSIONS.COMPAR"
964 include 'COMMON.LOCAL'
965 include 'COMMON.CHAIN'
966 include 'COMMON.DERIV'
967 include 'COMMON.NAMES'
968 include 'COMMON.INTERACT'
969 include 'COMMON.IOUNITS'
970 include 'COMMON.CALC'
972 c double precision rrsave(maxdim)
978 c eneps_temp(j,i)=0.0d0
983 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
984 c if (icall.eq.0) then
992 if (itypi.eq.ntyp1) cycle
993 itypi1=iabs(itype(i+1))
997 call to_box(xi,yi,zi)
998 dxi=dc_norm(1,nres+i)
999 dyi=dc_norm(2,nres+i)
1000 dzi=dc_norm(3,nres+i)
1001 dsci_inv=vbld_inv(i+nres)
1003 C Calculate SC interaction energy.
1005 do iint=1,nint_gr(i)
1006 do j=istart(i,iint),iend(i,iint)
1008 itypj=iabs(itype(j))
1009 if (itypj.eq.ntyp1) cycle
1010 dscj_inv=vbld_inv(j+nres)
1011 chi1=chi(itypi,itypj)
1012 chi2=chi(itypj,itypi)
1019 alf12=0.5D0*(alf1+alf2)
1020 C For diagnostics only!!!
1033 call to_box(xj,yj,zj)
1034 xj=boxshift(xj-xi,boxxsize)
1035 yj=boxshift(yj-yi,boxysize)
1036 zj=boxshift(zj-zi,boxzsize)
1037 dxj=dc_norm(1,nres+j)
1038 dyj=dc_norm(2,nres+j)
1039 dzj=dc_norm(3,nres+j)
1040 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1041 cd if (icall.eq.0) then
1047 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1049 C Calculate whole angle-dependent part of epsilon and contributions
1050 C to its derivatives
1051 fac=(rrij*sigsq)**expon2
1054 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1055 eps2der=evdwij*eps3rt
1056 eps3der=evdwij*eps2rt
1057 evdwij=evdwij*eps2rt*eps3rt
1058 ij=icant(itypi,itypj)
1059 aux=eps1*eps2rt**2*eps3rt**2
1060 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
1061 c & /dabs(eps(itypi,itypj))
1062 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
1063 if (bb.gt.0.0d0) then
1066 evdw_t=evdw_t+evdwij
1070 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1072 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1073 & restyp(itypi),i,restyp(itypj),j,
1074 & epsi,sigm,chi1,chi2,chip1,chip2,
1075 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1076 & om1,om2,om12,1.0D0/dsqrt(rrij),
1079 C Calculate gradient components.
1080 e1=e1*eps1*eps2rt**2*eps3rt**2
1081 fac=-expon*(e1+evdwij)
1084 C Calculate radial part of the gradient
1088 C Calculate the angular part of the gradient and sum add the contributions
1089 C to the appropriate components of the Cartesian gradient.
1098 C-----------------------------------------------------------------------------
1099 subroutine egb(evdw,evdw_t)
1101 C This subroutine calculates the interaction energy of nonbonded side chains
1102 C assuming the Gay-Berne potential of interaction.
1104 implicit real*8 (a-h,o-z)
1105 include 'DIMENSIONS'
1106 include "DIMENSIONS.COMPAR"
1107 include 'COMMON.CONTROL'
1108 include 'COMMON.GEO'
1109 include 'COMMON.VAR'
1110 include 'COMMON.LOCAL'
1111 include 'COMMON.CHAIN'
1112 include 'COMMON.DERIV'
1113 include 'COMMON.NAMES'
1114 include 'COMMON.INTERACT'
1115 include 'COMMON.IOUNITS'
1116 include 'COMMON.CALC'
1117 include 'COMMON.SBRIDGE'
1120 integer icant,xshift,yshift,zshift
1124 c eneps_temp(j,i)=0.0d0
1127 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1131 c if (icall.gt.0) lprn=.true.
1133 do i=iatsc_s,iatsc_e
1134 itypi=iabs(itype(i))
1135 if (itypi.eq.ntyp1) cycle
1136 itypi1=iabs(itype(i+1))
1140 C returning the ith atom to box
1141 call to_box(xi,yi,zi)
1142 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1143 dxi=dc_norm(1,nres+i)
1144 dyi=dc_norm(2,nres+i)
1145 dzi=dc_norm(3,nres+i)
1146 dsci_inv=vbld_inv(i+nres)
1148 C Calculate SC interaction energy.
1150 do iint=1,nint_gr(i)
1151 do j=istart(i,iint),iend(i,iint)
1152 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1153 call dyn_ssbond_ene(i,j,evdwij)
1155 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1156 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1157 C triple bond artifac removal
1158 do k=j+1,iend(i,iint)
1159 C search over all next residues
1160 if (dyn_ss_mask(k)) then
1161 C check if they are cysteins
1162 C write(iout,*) 'k=',k
1163 call triple_ssbond_ene(i,j,k,evdwij)
1164 C call the energy function that removes the artifical triple disulfide
1165 C bond the soubroutine is located in ssMD.F
1167 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1168 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1169 endif!dyn_ss_mask(k)
1173 itypj=iabs(itype(j))
1174 if (itypj.eq.ntyp1) cycle
1175 dscj_inv=vbld_inv(j+nres)
1176 sig0ij=sigma(itypi,itypj)
1177 chi1=chi(itypi,itypj)
1178 chi2=chi(itypj,itypi)
1185 alf12=0.5D0*(alf1+alf2)
1186 C For diagnostics only!!!
1199 C returning jth atom to box
1200 call to_box(xj,yj,zj)
1201 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1202 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1203 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1204 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1205 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1206 xj=boxshift(xj-xi,boxxsize)
1207 yj=boxshift(yj-yi,boxysize)
1208 zj=boxshift(zj-zi,boxzsize)
1209 dxj=dc_norm(1,nres+j)
1210 dyj=dc_norm(2,nres+j)
1211 dzj=dc_norm(3,nres+j)
1212 c write (iout,*) i,j,xj,yj,zj
1213 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1215 sss=sscale(1.0d0/rij)
1216 sssgrad=sscagrad(1.0d0/rij)
1217 if (sss.le.0.0) cycle
1218 C Calculate angle-dependent terms of energy and contributions to their
1223 sig=sig0ij*dsqrt(sigsq)
1224 rij_shift=1.0D0/rij-sig+sig0ij
1225 C I hate to put IF's in the loops, but here don't have another choice!!!!
1226 if (rij_shift.le.0.0D0) then
1231 c---------------------------------------------------------------
1232 rij_shift=1.0D0/rij_shift
1233 fac=rij_shift**expon
1236 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1237 eps2der=evdwij*eps3rt
1238 eps3der=evdwij*eps2rt
1239 evdwij=evdwij*eps2rt*eps3rt
1241 evdw=evdw+evdwij*sss
1243 evdw_t=evdw_t+evdwij*sss
1245 ij=icant(itypi,itypj)
1246 aux=eps1*eps2rt**2*eps3rt**2
1247 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1248 c & /dabs(eps(itypi,itypj))
1249 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1250 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1251 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1252 c & aux*e2/eps(itypi,itypj)
1254 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1258 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1259 & restyp(itypi),i,restyp(itypj),j,
1260 & epsi,sigm,chi1,chi2,chip1,chip2,
1261 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1262 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1264 write (iout,*) "partial sum", evdw, evdw_t
1268 if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)')
1269 & 'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij
1271 C Calculate gradient components.
1272 e1=e1*eps1*eps2rt**2*eps3rt**2
1273 fac=-expon*(e1+evdwij)*rij_shift
1276 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1277 C Calculate the radial part of the gradient
1278 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1279 & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1280 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1281 & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1282 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1283 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1287 C Calculate angular part of the gradient.
1290 C write(iout,*) "partial sum", evdw, evdw_t
1297 C-----------------------------------------------------------------------------
1298 subroutine egbv(evdw,evdw_t)
1300 C This subroutine calculates the interaction energy of nonbonded side chains
1301 C assuming the Gay-Berne-Vorobjev potential of interaction.
1303 implicit real*8 (a-h,o-z)
1304 include 'DIMENSIONS'
1305 include "DIMENSIONS.COMPAR"
1306 include 'COMMON.GEO'
1307 include 'COMMON.VAR'
1308 include 'COMMON.LOCAL'
1309 include 'COMMON.CHAIN'
1310 include 'COMMON.DERIV'
1311 include 'COMMON.NAMES'
1312 include 'COMMON.INTERACT'
1313 include 'COMMON.IOUNITS'
1314 include 'COMMON.CALC'
1315 common /srutu/ icall
1321 c eneps_temp(j,i)=0.0d0
1326 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1329 c if (icall.gt.0) lprn=.true.
1331 do i=iatsc_s,iatsc_e
1332 itypi=iabs(itype(i))
1333 if (itypi.eq.ntyp1) cycle
1334 itypi1=iabs(itype(i+1))
1338 call to_box(xi,yi,zi)
1339 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1340 dxi=dc_norm(1,nres+i)
1341 dyi=dc_norm(2,nres+i)
1342 dzi=dc_norm(3,nres+i)
1343 dsci_inv=vbld_inv(i+nres)
1345 C Calculate SC interaction energy.
1347 do iint=1,nint_gr(i)
1348 do j=istart(i,iint),iend(i,iint)
1350 itypj=iabs(itype(j))
1351 if (itypj.eq.ntyp1) cycle
1352 dscj_inv=vbld_inv(j+nres)
1353 sig0ij=sigma(itypi,itypj)
1354 r0ij=r0(itypi,itypj)
1355 chi1=chi(itypi,itypj)
1356 chi2=chi(itypj,itypi)
1363 alf12=0.5D0*(alf1+alf2)
1364 C For diagnostics only!!!
1377 call to_box(xj,yj,zj)
1378 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1379 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1380 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1381 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1382 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1383 dxj=dc_norm(1,nres+j)
1384 dyj=dc_norm(2,nres+j)
1385 dzj=dc_norm(3,nres+j)
1386 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1388 sss=sscale(1.0d0/rij)
1389 if (sss.eq.0.0d0) cycle
1390 sssgrad=sscagrad(1.0d0/rij)
1391 C Calculate angle-dependent terms of energy and contributions to their
1395 sig=sig0ij*dsqrt(sigsq)
1396 rij_shift=1.0D0/rij-sig+r0ij
1397 C I hate to put IF's in the loops, but here don't have another choice!!!!
1398 if (rij_shift.le.0.0D0) then
1403 c---------------------------------------------------------------
1404 rij_shift=1.0D0/rij_shift
1405 fac=rij_shift**expon
1408 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1409 eps2der=evdwij*eps3rt
1410 eps3der=evdwij*eps2rt
1411 fac_augm=rrij**expon
1412 e_augm=augm(itypi,itypj)*fac_augm
1413 evdwij=evdwij*eps2rt*eps3rt
1414 if (bb.gt.0.0d0) then
1415 evdw=evdw+(evdwij+e_augm)*sss
1417 evdw_t=evdw_t+(evdwij+e_augm)*sss
1419 ij=icant(itypi,itypj)
1420 aux=eps1*eps2rt**2*eps3rt**2
1421 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1422 c & /dabs(eps(itypi,itypj))
1423 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1424 c eneps_temp(ij)=eneps_temp(ij)
1425 c & +(evdwij+e_augm)/eps(itypi,itypj)
1427 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1428 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1429 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1430 c & restyp(itypi),i,restyp(itypj),j,
1431 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1432 c & chi1,chi2,chip1,chip2,
1433 c & eps1,eps2rt**2,eps3rt**2,
1434 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1438 C Calculate gradient components.
1439 e1=e1*eps1*eps2rt**2*eps3rt**2
1440 fac=-expon*(e1+evdwij)*rij_shift
1442 fac=rij*fac-2*expon*rrij*e_augm
1443 fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
1444 C Calculate the radial part of the gradient
1445 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1446 & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1447 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1448 & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1449 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1450 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1454 C Calculate angular part of the gradient.
1462 C-----------------------------------------------------------------------------
1463 subroutine sc_angular
1464 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1465 C om12. Called by ebp, egb, and egbv.
1467 include 'COMMON.CALC'
1471 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1472 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1473 om12=dxi*dxj+dyi*dyj+dzi*dzj
1475 C Calculate eps1(om12) and its derivative in om12
1476 faceps1=1.0D0-om12*chiom12
1477 faceps1_inv=1.0D0/faceps1
1478 eps1=dsqrt(faceps1_inv)
1479 C Following variable is eps1*deps1/dom12
1480 eps1_om12=faceps1_inv*chiom12
1481 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1486 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1487 sigsq=1.0D0-facsig*faceps1_inv
1488 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1489 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1490 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1491 C Calculate eps2 and its derivatives in om1, om2, and om12.
1494 chipom12=chip12*om12
1495 facp=1.0D0-om12*chipom12
1497 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1498 C Following variable is the square root of eps2
1499 eps2rt=1.0D0-facp1*facp_inv
1500 C Following three variables are the derivatives of the square root of eps
1501 C in om1, om2, and om12.
1502 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1503 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1504 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1505 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1506 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1507 C Calculate whole angle-dependent part of epsilon and contributions
1508 C to its derivatives
1511 C----------------------------------------------------------------------------
1513 implicit real*8 (a-h,o-z)
1514 include 'DIMENSIONS'
1515 include 'COMMON.CHAIN'
1516 include 'COMMON.DERIV'
1517 include 'COMMON.CALC'
1518 double precision dcosom1(3),dcosom2(3)
1519 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1520 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1521 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1522 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1524 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1525 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1528 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1531 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1532 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1533 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1534 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1535 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1536 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1539 C Calculate the components of the gradient in DC and X
1543 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1548 c------------------------------------------------------------------------------
1549 subroutine vec_and_deriv
1550 implicit real*8 (a-h,o-z)
1551 include 'DIMENSIONS'
1552 include 'COMMON.IOUNITS'
1553 include 'COMMON.GEO'
1554 include 'COMMON.VAR'
1555 include 'COMMON.LOCAL'
1556 include 'COMMON.CHAIN'
1557 include 'COMMON.VECTORS'
1558 include 'COMMON.DERIV'
1559 include 'COMMON.INTERACT'
1560 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1561 C Compute the local reference systems. For reference system (i), the
1562 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1563 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1565 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1566 if (i.eq.nres-1) then
1567 C Case of the last full residue
1568 C Compute the Z-axis
1569 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1570 costh=dcos(pi-theta(nres))
1571 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1572 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1578 C Compute the derivatives of uz
1580 uzder(2,1,1)=-dc_norm(3,i-1)
1581 uzder(3,1,1)= dc_norm(2,i-1)
1582 uzder(1,2,1)= dc_norm(3,i-1)
1584 uzder(3,2,1)=-dc_norm(1,i-1)
1585 uzder(1,3,1)=-dc_norm(2,i-1)
1586 uzder(2,3,1)= dc_norm(1,i-1)
1589 uzder(2,1,2)= dc_norm(3,i)
1590 uzder(3,1,2)=-dc_norm(2,i)
1591 uzder(1,2,2)=-dc_norm(3,i)
1593 uzder(3,2,2)= dc_norm(1,i)
1594 uzder(1,3,2)= dc_norm(2,i)
1595 uzder(2,3,2)=-dc_norm(1,i)
1598 C Compute the Y-axis
1601 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1604 C Compute the derivatives of uy
1607 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1608 & -dc_norm(k,i)*dc_norm(j,i-1)
1609 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1611 uyder(j,j,1)=uyder(j,j,1)-costh
1612 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1617 uygrad(l,k,j,i)=uyder(l,k,j)
1618 uzgrad(l,k,j,i)=uzder(l,k,j)
1622 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1623 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1624 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1625 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1629 C Compute the Z-axis
1630 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1631 costh=dcos(pi-theta(i+2))
1632 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1637 C Compute the derivatives of uz
1639 uzder(2,1,1)=-dc_norm(3,i+1)
1640 uzder(3,1,1)= dc_norm(2,i+1)
1641 uzder(1,2,1)= dc_norm(3,i+1)
1643 uzder(3,2,1)=-dc_norm(1,i+1)
1644 uzder(1,3,1)=-dc_norm(2,i+1)
1645 uzder(2,3,1)= dc_norm(1,i+1)
1648 uzder(2,1,2)= dc_norm(3,i)
1649 uzder(3,1,2)=-dc_norm(2,i)
1650 uzder(1,2,2)=-dc_norm(3,i)
1652 uzder(3,2,2)= dc_norm(1,i)
1653 uzder(1,3,2)= dc_norm(2,i)
1654 uzder(2,3,2)=-dc_norm(1,i)
1657 C Compute the Y-axis
1660 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1663 C Compute the derivatives of uy
1666 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1667 & -dc_norm(k,i)*dc_norm(j,i+1)
1668 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1670 uyder(j,j,1)=uyder(j,j,1)-costh
1671 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1676 uygrad(l,k,j,i)=uyder(l,k,j)
1677 uzgrad(l,k,j,i)=uzder(l,k,j)
1681 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1682 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1683 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1684 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1690 vbld_inv_temp(1)=vbld_inv(i+1)
1691 if (i.lt.nres-1) then
1692 vbld_inv_temp(2)=vbld_inv(i+2)
1694 vbld_inv_temp(2)=vbld_inv(i)
1699 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1700 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1708 C--------------------------------------------------------------------------
1709 subroutine set_matrices
1710 implicit real*8 (a-h,o-z)
1711 include 'DIMENSIONS'
1715 integer status(MPI_STATUS_SIZE)
1717 include 'COMMON.IOUNITS'
1718 include 'COMMON.GEO'
1719 include 'COMMON.VAR'
1720 include 'COMMON.LOCAL'
1721 include 'COMMON.CHAIN'
1722 include 'COMMON.DERIV'
1723 include 'COMMON.INTERACT'
1724 include 'COMMON.CONTACTS'
1725 include 'COMMON.TORSION'
1726 include 'COMMON.VECTORS'
1727 include 'COMMON.FFIELD'
1728 include 'COMMON.CORRMAT'
1729 double precision auxvec(2),auxmat(2,2)
1731 C Compute the virtual-bond-torsional-angle dependent quantities needed
1732 C to calculate the el-loc multibody terms of various order.
1734 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1738 innt=chain_border(1,ii)
1739 inct=chain_border(2,ii)
1740 if (i.gt. innt+2 .and. i.lt.inct+2) then
1741 iti = itype2loc(itype(i-2))
1745 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1746 if (i.gt. innt+1 .and. i.lt.inct+1) then
1747 iti1 = itype2loc(itype(i-1))
1752 cost1=dcos(theta(i-1))
1753 sint1=dsin(theta(i-1))
1755 sint1cub=sint1sq*sint1
1756 sint1cost1=2*sint1*cost1
1758 write (iout,*) "bnew1",i,iti
1759 write (iout,*) (bnew1(k,1,iti),k=1,3)
1760 write (iout,*) (bnew1(k,2,iti),k=1,3)
1761 write (iout,*) "bnew2",i,iti
1762 write (iout,*) (bnew2(k,1,iti),k=1,3)
1763 write (iout,*) (bnew2(k,2,iti),k=1,3)
1766 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1768 gtb1(k,i-2)=cost1*b1k-sint1sq*
1769 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1770 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1772 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1773 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1776 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1777 cc(1,k,i-2)=sint1sq*aux
1778 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1779 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1780 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1781 dd(1,k,i-2)=sint1sq*aux
1782 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1783 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1785 cc(2,1,i-2)=cc(1,2,i-2)
1786 cc(2,2,i-2)=-cc(1,1,i-2)
1787 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1788 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1789 dd(2,1,i-2)=dd(1,2,i-2)
1790 dd(2,2,i-2)=-dd(1,1,i-2)
1791 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1792 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1795 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1796 EE(l,k,i-2)=sint1sq*aux
1798 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1801 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1802 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1803 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1804 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1806 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1807 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1808 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1810 c b1tilde(1,i-2)=b1(1,i-2)
1811 c b1tilde(2,i-2)=-b1(2,i-2)
1812 c b2tilde(1,i-2)=b2(1,i-2)
1813 c b2tilde(2,i-2)=-b2(2,i-2)
1815 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1816 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1817 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1818 write (iout,*) 'theta=', theta(i-1)
1821 if (i.gt. innt+2 .and. i.lt.inct+2) then
1822 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1823 iti = itype2loc(itype(i-2))
1827 c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
1828 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1829 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1830 iti1 = itype2loc(itype(i-1))
1834 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1835 c iti = itype2loc(itype(i-2))
1839 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1840 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1841 c iti1 = itype2loc(itype(i-1))
1851 CC(k,l,i-2)=ccold(k,l,iti)
1852 DD(k,l,i-2)=ddold(k,l,iti)
1853 EE(k,l,i-2)=eeold(k,l,iti)
1857 b1tilde(1,i-2)= b1(1,i-2)
1858 b1tilde(2,i-2)=-b1(2,i-2)
1859 b2tilde(1,i-2)= b2(1,i-2)
1860 b2tilde(2,i-2)=-b2(2,i-2)
1862 Ctilde(1,1,i-2)= CC(1,1,i-2)
1863 Ctilde(1,2,i-2)= CC(1,2,i-2)
1864 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1865 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1867 Dtilde(1,1,i-2)= DD(1,1,i-2)
1868 Dtilde(1,2,i-2)= DD(1,2,i-2)
1869 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1870 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1871 c write(iout,*) "i",i," iti",iti
1872 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1873 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1876 if (i .lt. nres+1) then
1913 if (i .gt. 3 .and. i .lt. nres+1) then
1914 obrot_der(1,i-2)=-sin1
1915 obrot_der(2,i-2)= cos1
1916 Ugder(1,1,i-2)= sin1
1917 Ugder(1,2,i-2)=-cos1
1918 Ugder(2,1,i-2)=-cos1
1919 Ugder(2,2,i-2)=-sin1
1922 obrot2_der(1,i-2)=-dwasin2
1923 obrot2_der(2,i-2)= dwacos2
1924 Ug2der(1,1,i-2)= dwasin2
1925 Ug2der(1,2,i-2)=-dwacos2
1926 Ug2der(2,1,i-2)=-dwacos2
1927 Ug2der(2,2,i-2)=-dwasin2
1929 obrot_der(1,i-2)=0.0d0
1930 obrot_der(2,i-2)=0.0d0
1931 Ugder(1,1,i-2)=0.0d0
1932 Ugder(1,2,i-2)=0.0d0
1933 Ugder(2,1,i-2)=0.0d0
1934 Ugder(2,2,i-2)=0.0d0
1935 obrot2_der(1,i-2)=0.0d0
1936 obrot2_der(2,i-2)=0.0d0
1937 Ug2der(1,1,i-2)=0.0d0
1938 Ug2der(1,2,i-2)=0.0d0
1939 Ug2der(2,1,i-2)=0.0d0
1940 Ug2der(2,2,i-2)=0.0d0
1942 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1943 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1944 iti = itype2loc(itype(i-2))
1948 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1949 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1950 iti1 = itype2loc(itype(i-1))
1954 cd write (iout,*) '*******i',i,' iti1',iti
1955 cd write (iout,*) 'b1',b1(:,iti)
1956 cd write (iout,*) 'b2',b2(:,iti)
1957 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1958 c if (i .gt. iatel_s+2) then
1959 if (i .gt. nnt+2) then
1960 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1962 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1963 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1965 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1966 c & EE(1,2,iti),EE(2,2,i)
1967 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1968 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1969 c write(iout,*) "Macierz EUG",
1970 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
1973 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
1975 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
1976 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
1977 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1978 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
1979 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
1991 DtUg2(l,k,i-2)=0.0d0
1995 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
1996 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
1998 muder(k,i-2)=Ub2der(k,i-2)
2000 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2001 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2002 if (itype(i-1).le.ntyp) then
2003 iti1 = itype2loc(itype(i-1))
2011 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2014 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2015 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2016 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2017 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2018 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2019 & ((ee(l,k,i-2),l=1,2),k=1,2)
2021 cd write (iout,*) 'mu1',mu1(:,i-2)
2022 cd write (iout,*) 'mu2',mu2(:,i-2)
2024 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2027 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2028 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2029 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2030 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2031 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2033 C Vectors and matrices dependent on a single virtual-bond dihedral.
2034 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2035 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2036 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2037 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2038 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2040 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2041 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2042 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2043 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2049 C Matrices dependent on two consecutive virtual-bond dihedrals.
2050 C The order of matrices is from left to right.
2051 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2054 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2056 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2057 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2059 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2060 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2062 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2063 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2064 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2071 C--------------------------------------------------------------------------
2072 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2074 C This subroutine calculates the average interaction energy and its gradient
2075 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2076 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2077 C The potential depends both on the distance of peptide-group centers and on
2078 C the orientation of the CA-CA virtual bonds.
2080 implicit real*8 (a-h,o-z)
2084 include 'DIMENSIONS'
2085 include 'COMMON.CONTROL'
2086 include 'COMMON.IOUNITS'
2087 include 'COMMON.GEO'
2088 include 'COMMON.VAR'
2089 include 'COMMON.LOCAL'
2090 include 'COMMON.CHAIN'
2091 include 'COMMON.DERIV'
2092 include 'COMMON.INTERACT'
2094 include 'COMMON.CONTACTS'
2095 include 'COMMON.CONTMAT'
2097 include 'COMMON.CORRMAT'
2098 include 'COMMON.TORSION'
2099 include 'COMMON.VECTORS'
2100 include 'COMMON.FFIELD'
2101 include 'COMMON.TIME1'
2102 include 'COMMON.SPLITELE'
2103 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2104 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2105 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2106 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2107 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2108 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2110 double precision sslipi,sslipj,ssgradlipi,ssgradlipj
2111 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj
2112 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2114 double precision scal_el /1.0d0/
2116 double precision scal_el /0.5d0/
2119 C 13-go grudnia roku pamietnego...
2120 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2121 & 0.0d0,1.0d0,0.0d0,
2122 & 0.0d0,0.0d0,1.0d0/
2123 cd write(iout,*) 'In EELEC'
2125 cd write(iout,*) 'Type',i
2126 cd write(iout,*) 'B1',B1(:,i)
2127 cd write(iout,*) 'B2',B2(:,i)
2128 cd write(iout,*) 'CC',CC(:,:,i)
2129 cd write(iout,*) 'DD',DD(:,:,i)
2130 cd write(iout,*) 'EE',EE(:,:,i)
2132 cd call check_vecgrad
2134 if (icheckgrad.eq.1) then
2136 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2138 dc_norm(k,i)=dc(k,i)*fac
2140 c write (iout,*) 'i',i,' fac',fac
2143 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2144 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2145 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2146 c call vec_and_deriv
2152 time_mat=time_mat+MPI_Wtime()-time01
2156 cd write (iout,*) 'i=',i
2158 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2161 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2162 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2177 cd print '(a)','Enter EELEC'
2178 c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2181 gel_loc_loc(i)=0.0d0
2186 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2188 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2190 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2191 do i=iturn3_start,iturn3_end
2193 C write(iout,*) "tu jest i",i
2194 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2195 C changes suggested by Ana to avoid out of bounds
2196 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2197 c & .or.((i+4).gt.nres)
2198 c & .or.((i-1).le.0)
2199 C end of changes by Ana
2200 C dobra zmiana wycofana
2201 & .or. itype(i+2).eq.ntyp1
2202 & .or. itype(i+3).eq.ntyp1) cycle
2203 C Adam: Instructions below will switch off existing interactions
2205 c if(itype(i-1).eq.ntyp1)cycle
2207 c if(i.LT.nres-3)then
2208 c if (itype(i+4).eq.ntyp1) cycle
2213 dx_normi=dc_norm(1,i)
2214 dy_normi=dc_norm(2,i)
2215 dz_normi=dc_norm(3,i)
2216 xmedi=c(1,i)+0.5d0*dxi
2217 ymedi=c(2,i)+0.5d0*dyi
2218 zmedi=c(3,i)+0.5d0*dzi
2219 call to_box(xmedi,ymedi,zmedi)
2220 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2222 call eelecij(i,i+2,ees,evdw1,eel_loc)
2223 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2225 num_cont_hb(i)=num_conti
2228 do i=iturn4_start,iturn4_end
2230 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2231 C changes suggested by Ana to avoid out of bounds
2232 c & .or.((i+5).gt.nres)
2233 c & .or.((i-1).le.0)
2234 C end of changes suggested by Ana
2235 & .or. itype(i+3).eq.ntyp1
2236 & .or. itype(i+4).eq.ntyp1
2237 c & .or. itype(i+5).eq.ntyp1
2238 c & .or. itype(i).eq.ntyp1
2239 c & .or. itype(i-1).eq.ntyp1
2244 dx_normi=dc_norm(1,i)
2245 dy_normi=dc_norm(2,i)
2246 dz_normi=dc_norm(3,i)
2247 xmedi=c(1,i)+0.5d0*dxi
2248 ymedi=c(2,i)+0.5d0*dyi
2249 zmedi=c(3,i)+0.5d0*dzi
2250 call to_box(xmedi,ymedi,zmedi)
2251 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2253 num_conti=num_cont_hb(i)
2255 c write(iout,*) "JESTEM W PETLI"
2256 call eelecij(i,i+3,ees,evdw1,eel_loc)
2257 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2258 & call eturn4(i,eello_turn4)
2260 num_cont_hb(i)=num_conti
2263 C Loop over all neighbouring boxes
2268 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2271 do i=iatel_s,iatel_e
2274 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2275 C changes suggested by Ana to avoid out of bounds
2276 c & .or.((i+2).gt.nres)
2277 c & .or.((i-1).le.0)
2278 C end of changes by Ana
2279 c & .or. itype(i+2).eq.ntyp1
2280 c & .or. itype(i-1).eq.ntyp1
2285 dx_normi=dc_norm(1,i)
2286 dy_normi=dc_norm(2,i)
2287 dz_normi=dc_norm(3,i)
2288 xmedi=c(1,i)+0.5d0*dxi
2289 ymedi=c(2,i)+0.5d0*dyi
2290 zmedi=c(3,i)+0.5d0*dzi
2291 call to_box(xmedi,ymedi,zmedi)
2292 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2294 num_conti=num_cont_hb(i)
2297 do j=ielstart(i),ielend(i)
2299 C write (iout,*) i,j
2301 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2302 C changes suggested by Ana to avoid out of bounds
2303 c & .or.((j+2).gt.nres)
2304 c & .or.((j-1).le.0)
2305 C end of changes by Ana
2306 c & .or.itype(j+2).eq.ntyp1
2307 c & .or.itype(j-1).eq.ntyp1
2309 call eelecij(i,j,ees,evdw1,eel_loc)
2312 num_cont_hb(i)=num_conti
2319 c write (iout,*) "Number of loop steps in EELEC:",ind
2321 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2322 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2324 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2325 ccc eel_loc=eel_loc+eello_turn3
2326 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2329 C-------------------------------------------------------------------------------
2330 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2331 implicit real*8 (a-h,o-z)
2332 include 'DIMENSIONS'
2336 include 'COMMON.CONTROL'
2337 include 'COMMON.IOUNITS'
2338 include 'COMMON.GEO'
2339 include 'COMMON.VAR'
2340 include 'COMMON.LOCAL'
2341 include 'COMMON.CHAIN'
2342 include 'COMMON.DERIV'
2343 include 'COMMON.INTERACT'
2345 include 'COMMON.CONTACTS'
2346 include 'COMMON.CONTMAT'
2348 include 'COMMON.CORRMAT'
2349 include 'COMMON.TORSION'
2350 include 'COMMON.VECTORS'
2351 include 'COMMON.FFIELD'
2352 include 'COMMON.TIME1'
2353 include 'COMMON.SPLITELE'
2354 include 'COMMON.SHIELD'
2355 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2356 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2357 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2358 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2359 & gmuij2(4),gmuji2(4)
2360 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2361 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2363 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij,
2365 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
2366 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2368 double precision scal_el /1.0d0/
2370 double precision scal_el /0.5d0/
2373 C 13-go grudnia roku pamietnego...
2374 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2375 & 0.0d0,1.0d0,0.0d0,
2376 & 0.0d0,0.0d0,1.0d0/
2377 integer xshift,yshift,zshift
2378 c time00=MPI_Wtime()
2379 cd write (iout,*) "eelecij",i,j
2383 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2384 aaa=app(iteli,itelj)
2385 bbb=bpp(iteli,itelj)
2386 ael6i=ael6(iteli,itelj)
2387 ael3i=ael3(iteli,itelj)
2391 dx_normj=dc_norm(1,j)
2392 dy_normj=dc_norm(2,j)
2393 dz_normj=dc_norm(3,j)
2394 C xj=c(1,j)+0.5D0*dxj-xmedi
2395 C yj=c(2,j)+0.5D0*dyj-ymedi
2396 C zj=c(3,j)+0.5D0*dzj-zmedi
2400 call to_box(xj,yj,zj)
2401 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
2402 faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
2403 faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
2404 xj=boxshift(xj-xmedi,boxxsize)
2405 yj=boxshift(yj-ymedi,boxysize)
2406 zj=boxshift(zj-zmedi,boxzsize)
2407 rij=xj*xj+yj*yj+zj*zj
2408 sss=sscale(sqrt(rij))
2409 if (sss.eq.0.0d0) return
2410 sssgrad=sscagrad(sqrt(rij))
2411 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2412 c & " rlamb",rlamb," sss",sss
2413 c if (sss.gt.0.0d0) then
2419 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2420 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2421 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2422 fac=cosa-3.0D0*cosb*cosg
2424 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2425 if (j.eq.i+2) ev1=scal_el*ev1
2430 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2434 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2435 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2436 if (shield_mode.gt.0) then
2439 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2440 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2442 ees=ees+eesij*faclipij2
2447 ees=ees+eesij*faclipij2
2449 evdw1=evdw1+evdwij*sss*faclipij2
2450 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2451 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2452 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2453 cd & xmedi,ymedi,zmedi,xj,yj,zj
2455 if (energy_dec) then
2456 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2457 & 'evdw1',i,j,evdwij,iteli,itelj,aaa,evdw1,sss
2458 write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij,
2459 & fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij,
2464 C Calculate contributions to the Cartesian gradient.
2467 facvdw=-6*rrmij*(ev1+evdwij)*sss
2468 facel=-3*rrmij*(el1+eesij)
2475 * Radial derivatives. First process both termini of the fragment (i,j)
2478 aux=(facel*sss+rmij*sssgrad*eesij)*faclipij2
2482 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2483 & (shield_mode.gt.0)) then
2485 do ilist=1,ishield_list(i)
2486 iresshield=shield_list(ilist,i)
2488 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2490 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2492 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2493 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2494 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2495 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2496 C if (iresshield.gt.i) then
2497 C do ishi=i+1,iresshield-1
2498 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2499 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2503 C do ishi=iresshield,i
2504 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2505 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2511 do ilist=1,ishield_list(j)
2512 iresshield=shield_list(ilist,j)
2514 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2516 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2518 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2519 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2521 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2522 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2523 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2524 C if (iresshield.gt.j) then
2525 C do ishi=j+1,iresshield-1
2526 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2527 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2531 C do ishi=iresshield,j
2532 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2533 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2540 gshieldc(k,i)=gshieldc(k,i)+
2541 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2542 gshieldc(k,j)=gshieldc(k,j)+
2543 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2544 gshieldc(k,i-1)=gshieldc(k,i-1)+
2545 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2546 gshieldc(k,j-1)=gshieldc(k,j-1)+
2547 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2552 c ghalf=0.5D0*ggg(k)
2553 c gelc(k,i)=gelc(k,i)+ghalf
2554 c gelc(k,j)=gelc(k,j)+ghalf
2556 c 9/28/08 AL Gradient compotents will be summed only at the end
2557 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2559 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2560 C & +grad_shield(k,j)*eesij/fac_shield(j)
2561 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2562 C & +grad_shield(k,i)*eesij/fac_shield(i)
2563 C gelc_long(k,i-1)=gelc_long(k,i-1)
2564 C & +grad_shield(k,i)*eesij/fac_shield(i)
2565 C gelc_long(k,j-1)=gelc_long(k,j-1)
2566 C & +grad_shield(k,j)*eesij/fac_shield(j)
2568 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2571 * Loop over residues i+1 thru j-1.
2575 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2578 if (sss.gt.0.0) then
2579 facvdw=facvdw+sssgrad*rmij*evdwij*faclipij2
2589 c ghalf=0.5D0*ggg(k)
2590 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2591 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2593 c 9/28/08 AL Gradient compotents will be summed only at the end
2595 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2596 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2599 * Loop over residues i+1 thru j-1.
2603 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2609 facvdw=(ev1+evdwij)*faclipij2
2612 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2613 & +(evdwij+eesij)*sssgrad*rrmij
2618 * Radial derivatives. First process both termini of the fragment (i,j)
2622 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2624 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2626 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2628 c ghalf=0.5D0*ggg(k)
2629 c gelc(k,i)=gelc(k,i)+ghalf
2630 c gelc(k,j)=gelc(k,j)+ghalf
2632 c 9/28/08 AL Gradient compotents will be summed only at the end
2634 gelc_long(k,j)=gelc(k,j)+ggg(k)
2635 gelc_long(k,i)=gelc(k,i)-ggg(k)
2638 * Loop over residues i+1 thru j-1.
2642 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2645 c 9/28/08 AL Gradient compotents will be summed only at the end
2646 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2647 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2648 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2650 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2651 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2659 ecosa=2.0D0*fac3*fac1+fac4
2662 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2663 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2665 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2666 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2668 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2669 cd & (dcosg(k),k=1,3)
2671 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2672 & fac_shield(i)**2*fac_shield(j)**2*sss*faclipij2
2675 c ghalf=0.5D0*ggg(k)
2676 c gelc(k,i)=gelc(k,i)+ghalf
2677 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2678 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2679 c gelc(k,j)=gelc(k,j)+ghalf
2680 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2681 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2685 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2688 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2691 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2692 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2693 & *fac_shield(i)**2*fac_shield(j)**2*faclipij2
2695 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2696 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2697 & *fac_shield(i)**2*fac_shield(j)**2*faclipij2
2698 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2699 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2701 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2706 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2707 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2708 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2710 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2711 C energy of a peptide unit is assumed in the form of a second-order
2712 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2713 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2714 C are computed for EVERY pair of non-contiguous peptide groups.
2717 if (j.lt.nres-1) then
2729 muij(kkk)=mu(k,i)*mu(l,j)
2730 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2733 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2734 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2735 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2736 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2737 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2738 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2744 write (iout,*) 'EELEC: i',i,' j',j
2745 write (iout,*) 'j',j,' j1',j1,' j2',j2
2746 write(iout,*) 'muij',muij
2747 write (iout,*) "uy",uy(:,i)
2748 write (iout,*) "uz",uz(:,j)
2749 write (iout,*) "erij",erij
2751 ury=scalar(uy(1,i),erij)
2752 urz=scalar(uz(1,i),erij)
2753 vry=scalar(uy(1,j),erij)
2754 vrz=scalar(uz(1,j),erij)
2755 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2756 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2757 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2758 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2759 fac=dsqrt(-ael6i)*r3ij
2764 cd write (iout,'(4i5,4f10.5)')
2765 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2766 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2767 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2768 cd & uy(:,j),uz(:,j)
2769 cd write (iout,'(4f10.5)')
2770 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2771 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2772 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2773 cd write (iout,'(9f10.5/)')
2774 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2775 C Derivatives of the elements of A in virtual-bond vectors
2777 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2779 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2780 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2781 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2782 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2783 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2784 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2785 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2786 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2787 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2788 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2789 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2790 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2792 C Compute radial contributions to the gradient
2810 C Add the contributions coming from er
2813 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2814 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2815 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2816 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2819 C Derivatives in DC(i)
2820 cgrad ghalf1=0.5d0*agg(k,1)
2821 cgrad ghalf2=0.5d0*agg(k,2)
2822 cgrad ghalf3=0.5d0*agg(k,3)
2823 cgrad ghalf4=0.5d0*agg(k,4)
2824 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2825 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2826 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2827 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2828 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2829 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2830 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2831 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2832 C Derivatives in DC(i+1)
2833 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2834 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2835 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2836 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2837 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2838 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2839 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2840 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2841 C Derivatives in DC(j)
2842 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2843 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2844 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2845 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2846 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2847 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2848 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2849 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2850 C Derivatives in DC(j+1) or DC(nres-1)
2851 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2852 & -3.0d0*vryg(k,3)*ury)
2853 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2854 & -3.0d0*vrzg(k,3)*ury)
2855 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2856 & -3.0d0*vryg(k,3)*urz)
2857 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2858 & -3.0d0*vrzg(k,3)*urz)
2859 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2861 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2876 aggi(k,l)=-aggi(k,l)
2877 aggi1(k,l)=-aggi1(k,l)
2878 aggj(k,l)=-aggj(k,l)
2879 aggj1(k,l)=-aggj1(k,l)
2883 if (j.lt.nres-1) then
2889 aggi(k,l)=-aggi(k,l)
2890 aggi1(k,l)=-aggi1(k,l)
2891 aggj(k,l)=-aggj(k,l)
2892 aggj1(k,l)=-aggj1(k,l)
2903 aggi(k,l)=-aggi(k,l)
2904 aggi1(k,l)=-aggi1(k,l)
2905 aggj(k,l)=-aggj(k,l)
2906 aggj1(k,l)=-aggj1(k,l)
2911 IF (wel_loc.gt.0.0d0) THEN
2912 C Contribution to the local-electrostatic energy coming from the i-j pair
2913 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2916 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
2918 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
2919 & " wel_loc",wel_loc
2921 if (shield_mode.eq.0) then
2928 eel_loc_ij=eel_loc_ij
2929 & *fac_shield(i)*fac_shield(j)*sss*faclipij
2930 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2931 & 'eelloc',i,j,eel_loc_ij
2932 c if (eel_loc_ij.ne.0)
2933 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
2934 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
2936 eel_loc=eel_loc+eel_loc_ij
2937 C Now derivative over eel_loc
2939 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2940 & (shield_mode.gt.0)) then
2943 do ilist=1,ishield_list(i)
2944 iresshield=shield_list(ilist,i)
2946 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2949 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2951 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2952 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2956 do ilist=1,ishield_list(j)
2957 iresshield=shield_list(ilist,j)
2959 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2962 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2964 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2965 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2972 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2973 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2974 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2975 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2976 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2977 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2978 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2979 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2984 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
2985 c & ' eel_loc_ij',eel_loc_ij
2986 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2987 C Calculate patrial derivative for theta angle
2989 geel_loc_ij=(a22*gmuij1(1)
2993 & *fac_shield(i)*fac_shield(j)*sss*faclipij
2994 c write(iout,*) "derivative over thatai"
2995 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
2997 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
2998 & geel_loc_ij*wel_loc
2999 c write(iout,*) "derivative over thatai-1"
3000 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3007 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3008 & geel_loc_ij*wel_loc
3009 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3011 c Derivative over j residue
3012 geel_loc_ji=a22*gmuji1(1)
3016 c write(iout,*) "derivative over thataj"
3017 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3020 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3021 & geel_loc_ji*wel_loc
3022 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3029 c write(iout,*) "derivative over thataj-1"
3030 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3032 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3033 & geel_loc_ji*wel_loc
3034 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3036 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3038 C Partial derivatives in virtual-bond dihedral angles gamma
3040 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3041 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3042 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3043 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3045 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3046 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3047 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3048 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3049 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3050 aux=eel_loc_ij/sss*sssgrad*rmij
3055 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3056 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3057 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3058 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3059 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3060 cgrad ghalf=0.5d0*ggg(l)
3061 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3062 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3066 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3069 C Remaining derivatives of eello
3070 gel_loc_long(3,j)=gel_loc_long(3,j)+
3071 & ssgradlipj*eel_loc_ij/2.0d0*lipscale/faclipij
3073 gel_loc_long(3,i)=gel_loc_long(3,i)+
3074 & ssgradlipi*eel_loc_ij/2.0d0*lipscale/faclipij
3076 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3077 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3078 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3080 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3081 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3082 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3084 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3085 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3086 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3088 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3089 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3090 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3097 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3098 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3100 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3101 & .and. num_conti.le.maxconts) then
3102 c write (iout,*) i,j," entered corr"
3104 C Calculate the contact function. The ith column of the array JCONT will
3105 C contain the numbers of atoms that make contacts with the atom I (of numbers
3106 C greater than I). The arrays FACONT and GACONT will contain the values of
3107 C the contact function and its derivative.
3108 c r0ij=1.02D0*rpp(iteli,itelj)
3109 c r0ij=1.11D0*rpp(iteli,itelj)
3110 r0ij=2.20D0*rpp(iteli,itelj)
3111 c r0ij=1.55D0*rpp(iteli,itelj)
3112 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3113 if (fcont.gt.0.0D0) then
3114 num_conti=num_conti+1
3115 if (num_conti.gt.maxconts) then
3116 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3117 & ' will skip next contacts for this conf.'
3119 jcont_hb(num_conti,i)=j
3120 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3121 cd & " jcont_hb",jcont_hb(num_conti,i)
3122 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3123 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3124 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3126 d_cont(num_conti,i)=rij
3127 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3128 C --- Electrostatic-interaction matrix ---
3129 a_chuj(1,1,num_conti,i)=a22
3130 a_chuj(1,2,num_conti,i)=a23
3131 a_chuj(2,1,num_conti,i)=a32
3132 a_chuj(2,2,num_conti,i)=a33
3133 C --- Gradient of rij
3136 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3143 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3144 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3145 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3146 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3147 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3153 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3154 C Calculate contact energies
3156 wij=cosa-3.0D0*cosb*cosg
3159 c fac3=dsqrt(-ael6i)/r0ij**3
3160 fac3=dsqrt(-ael6i)*r3ij
3161 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3162 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3163 if (ees0tmp.gt.0) then
3164 ees0pij=dsqrt(ees0tmp)
3168 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3169 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3170 if (ees0tmp.gt.0) then
3171 ees0mij=dsqrt(ees0tmp)
3176 if (shield_mode.eq.0) then
3180 ees0plist(num_conti,i)=j
3181 C fac_shield(i)=0.4d0
3182 C fac_shield(j)=0.6d0
3184 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3185 & *fac_shield(i)*fac_shield(j)
3186 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3187 & *fac_shield(i)*fac_shield(j)
3188 C Diagnostics. Comment out or remove after debugging!
3189 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3190 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3191 c ees0m(num_conti,i)=0.0D0
3193 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3194 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3195 C Angular derivatives of the contact function
3197 ees0pij1=fac3/ees0pij
3198 ees0mij1=fac3/ees0mij
3199 fac3p=-3.0D0*fac3*rrmij
3200 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3201 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3203 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3204 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3205 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3206 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3207 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3208 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3209 ecosap=ecosa1+ecosa2
3210 ecosbp=ecosb1+ecosb2
3211 ecosgp=ecosg1+ecosg2
3212 ecosam=ecosa1-ecosa2
3213 ecosbm=ecosb1-ecosb2
3214 ecosgm=ecosg1-ecosg2
3223 facont_hb(num_conti,i)=fcont
3226 fprimcont=fprimcont/rij
3227 cd facont_hb(num_conti,i)=1.0D0
3228 C Following line is for diagnostics.
3231 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3232 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3235 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3236 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3238 gggp(1)=gggp(1)+ees0pijp*xj
3239 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3240 gggp(2)=gggp(2)+ees0pijp*yj
3241 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3242 gggp(3)=gggp(3)+ees0pijp*zj
3243 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3244 gggm(1)=gggm(1)+ees0mijp*xj
3245 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3246 gggm(2)=gggm(2)+ees0mijp*yj
3247 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3248 gggm(3)=gggm(3)+ees0mijp*zj
3249 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3250 C Derivatives due to the contact function
3251 gacont_hbr(1,num_conti,i)=fprimcont*xj
3252 gacont_hbr(2,num_conti,i)=fprimcont*yj
3253 gacont_hbr(3,num_conti,i)=fprimcont*zj
3256 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3257 c following the change of gradient-summation algorithm.
3259 cgrad ghalfp=0.5D0*gggp(k)
3260 cgrad ghalfm=0.5D0*gggm(k)
3261 gacontp_hb1(k,num_conti,i)=!ghalfp
3262 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3263 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3264 & *fac_shield(i)*fac_shield(j)*sss
3266 gacontp_hb2(k,num_conti,i)=!ghalfp
3267 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3268 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3269 & *fac_shield(i)*fac_shield(j)*sss
3271 gacontp_hb3(k,num_conti,i)=gggp(k)
3272 & *fac_shield(i)*fac_shield(j)*sss
3274 gacontm_hb1(k,num_conti,i)=!ghalfm
3275 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3276 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3277 & *fac_shield(i)*fac_shield(j)*sss
3279 gacontm_hb2(k,num_conti,i)=!ghalfm
3280 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3281 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3282 & *fac_shield(i)*fac_shield(j)*sss
3284 gacontm_hb3(k,num_conti,i)=gggm(k)
3285 & *fac_shield(i)*fac_shield(j)
3288 C Diagnostics. Comment out or remove after debugging!
3290 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3291 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3292 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3293 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3294 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3295 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3301 endif ! num_conti.le.maxconts
3306 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3309 ghalf=0.5d0*agg(l,k)
3310 aggi(l,k)=aggi(l,k)+ghalf
3311 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3312 aggj(l,k)=aggj(l,k)+ghalf
3315 if (j.eq.nres-1 .and. i.lt.j-2) then
3318 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3324 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3327 C-----------------------------------------------------------------------------
3328 subroutine eturn3(i,eello_turn3)
3329 C Third- and fourth-order contributions from turns
3330 implicit real*8 (a-h,o-z)
3331 include 'DIMENSIONS'
3332 include 'COMMON.IOUNITS'
3333 include 'COMMON.GEO'
3334 include 'COMMON.VAR'
3335 include 'COMMON.LOCAL'
3336 include 'COMMON.CHAIN'
3337 include 'COMMON.DERIV'
3338 include 'COMMON.INTERACT'
3339 include 'COMMON.CORRMAT'
3340 include 'COMMON.TORSION'
3341 include 'COMMON.VECTORS'
3342 include 'COMMON.FFIELD'
3343 include 'COMMON.CONTROL'
3344 include 'COMMON.SHIELD'
3346 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3347 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3348 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3349 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3350 & auxgmat2(2,2),auxgmatt2(2,2)
3351 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3352 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3353 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3354 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3356 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3357 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3359 c write (iout,*) "eturn3",i,j,j1,j2
3364 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3366 C Third-order contributions
3373 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3374 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3375 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3376 c auxalary matices for theta gradient
3377 c auxalary matrix for i+1 and constant i+2
3378 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3379 c auxalary matrix for i+2 and constant i+1
3380 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3381 call transpose2(auxmat(1,1),auxmat1(1,1))
3382 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3383 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3384 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3385 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3386 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3387 if (shield_mode.eq.0) then
3394 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3395 & *fac_shield(i)*fac_shield(j)*faclipij
3396 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3397 & *fac_shield(i)*fac_shield(j)
3398 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3402 C Derivatives in theta
3403 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3404 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3405 & *fac_shield(i)*fac_shield(j)*faclipij
3406 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3407 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3408 & *fac_shield(i)*fac_shield(j)*faclipij
3411 C Derivatives in shield mode
3412 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3413 & (shield_mode.gt.0)) then
3416 do ilist=1,ishield_list(i)
3417 iresshield=shield_list(ilist,i)
3419 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3421 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3423 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3424 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3428 do ilist=1,ishield_list(j)
3429 iresshield=shield_list(ilist,j)
3431 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3433 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3435 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3436 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3443 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3444 & grad_shield(k,i)*eello_t3/fac_shield(i)
3445 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3446 & grad_shield(k,j)*eello_t3/fac_shield(j)
3447 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3448 & grad_shield(k,i)*eello_t3/fac_shield(i)
3449 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3450 & grad_shield(k,j)*eello_t3/fac_shield(j)
3454 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3455 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3456 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3457 cd & ' eello_turn3_num',4*eello_turn3_num
3458 C Derivatives in gamma(i)
3459 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3460 call transpose2(auxmat2(1,1),auxmat3(1,1))
3461 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3462 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3463 & *fac_shield(i)*fac_shield(j)*faclipij
3464 C Derivatives in gamma(i+1)
3465 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3466 call transpose2(auxmat2(1,1),auxmat3(1,1))
3467 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3468 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3469 & +0.5d0*(pizda(1,1)+pizda(2,2))
3470 & *fac_shield(i)*fac_shield(j)*faclipij
3471 C Cartesian derivatives
3473 c ghalf1=0.5d0*agg(l,1)
3474 c ghalf2=0.5d0*agg(l,2)
3475 c ghalf3=0.5d0*agg(l,3)
3476 c ghalf4=0.5d0*agg(l,4)
3477 a_temp(1,1)=aggi(l,1)!+ghalf1
3478 a_temp(1,2)=aggi(l,2)!+ghalf2
3479 a_temp(2,1)=aggi(l,3)!+ghalf3
3480 a_temp(2,2)=aggi(l,4)!+ghalf4
3481 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3482 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3483 & +0.5d0*(pizda(1,1)+pizda(2,2))
3484 & *fac_shield(i)*fac_shield(j)*faclipij
3486 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3487 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3488 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3489 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3490 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3491 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3492 & +0.5d0*(pizda(1,1)+pizda(2,2))
3493 & *fac_shield(i)*fac_shield(j)*faclipij
3494 a_temp(1,1)=aggj(l,1)!+ghalf1
3495 a_temp(1,2)=aggj(l,2)!+ghalf2
3496 a_temp(2,1)=aggj(l,3)!+ghalf3
3497 a_temp(2,2)=aggj(l,4)!+ghalf4
3498 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3499 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3500 & +0.5d0*(pizda(1,1)+pizda(2,2))
3501 & *fac_shield(i)*fac_shield(j)*faclipij
3502 a_temp(1,1)=aggj1(l,1)
3503 a_temp(1,2)=aggj1(l,2)
3504 a_temp(2,1)=aggj1(l,3)
3505 a_temp(2,2)=aggj1(l,4)
3506 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3507 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3508 & +0.5d0*(pizda(1,1)+pizda(2,2))
3509 & *fac_shield(i)*fac_shield(j)*faclipij
3516 C-------------------------------------------------------------------------------
3517 subroutine eturn4(i,eello_turn4)
3518 C Third- and fourth-order contributions from turns
3519 implicit real*8 (a-h,o-z)
3520 include 'DIMENSIONS'
3521 include 'COMMON.IOUNITS'
3522 include 'COMMON.GEO'
3523 include 'COMMON.VAR'
3524 include 'COMMON.LOCAL'
3525 include 'COMMON.CHAIN'
3526 include 'COMMON.DERIV'
3527 include 'COMMON.INTERACT'
3528 include 'COMMON.CORRMAT'
3529 include 'COMMON.TORSION'
3530 include 'COMMON.VECTORS'
3531 include 'COMMON.FFIELD'
3532 include 'COMMON.CONTROL'
3533 include 'COMMON.SHIELD'
3535 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3536 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3537 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3538 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3539 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3540 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3541 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3542 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3543 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3544 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3545 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3548 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3550 C Fourth-order contributions
3558 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3559 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3560 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3561 c write(iout,*)"WCHODZE W PROGRAM"
3566 iti1=itype2loc(itype(i+1))
3567 iti2=itype2loc(itype(i+2))
3568 iti3=itype2loc(itype(i+3))
3569 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3570 call transpose2(EUg(1,1,i+1),e1t(1,1))
3571 call transpose2(Eug(1,1,i+2),e2t(1,1))
3572 call transpose2(Eug(1,1,i+3),e3t(1,1))
3573 C Ematrix derivative in theta
3574 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3575 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3576 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3577 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3578 c eta1 in derivative theta
3579 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3580 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3581 c auxgvec is derivative of Ub2 so i+3 theta
3582 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3583 c auxalary matrix of E i+1
3584 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3587 s1=scalar2(b1(1,i+2),auxvec(1))
3588 c derivative of theta i+2 with constant i+3
3589 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3590 c derivative of theta i+2 with constant i+2
3591 gs32=scalar2(b1(1,i+2),auxgvec(1))
3592 c derivative of E matix in theta of i+1
3593 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3595 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3596 c ea31 in derivative theta
3597 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3598 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3599 c auxilary matrix auxgvec of Ub2 with constant E matirx
3600 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3601 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3602 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3606 s2=scalar2(b1(1,i+1),auxvec(1))
3607 c derivative of theta i+1 with constant i+3
3608 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3609 c derivative of theta i+2 with constant i+1
3610 gs21=scalar2(b1(1,i+1),auxgvec(1))
3611 c derivative of theta i+3 with constant i+1
3612 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3613 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3615 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3616 c two derivatives over diffetent matrices
3617 c gtae3e2 is derivative over i+3
3618 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3619 c ae3gte2 is derivative over i+2
3620 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3621 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3622 c three possible derivative over theta E matices
3624 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3626 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3628 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3629 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3631 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3632 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3633 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3634 if (shield_mode.eq.0) then
3641 eello_turn4=eello_turn4-(s1+s2+s3)
3642 & *fac_shield(i)*fac_shield(j)*faclipij
3643 eello_t4=-(s1+s2+s3)
3644 & *fac_shield(i)*fac_shield(j)
3645 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3646 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3647 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3648 C Now derivative over shield:
3649 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3650 & (shield_mode.gt.0)) then
3653 do ilist=1,ishield_list(i)
3654 iresshield=shield_list(ilist,i)
3656 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3658 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3660 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3661 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3665 do ilist=1,ishield_list(j)
3666 iresshield=shield_list(ilist,j)
3668 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3670 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3672 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3673 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3680 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3681 & grad_shield(k,i)*eello_t4/fac_shield(i)
3682 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3683 & grad_shield(k,j)*eello_t4/fac_shield(j)
3684 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3685 & grad_shield(k,i)*eello_t4/fac_shield(i)
3686 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3687 & grad_shield(k,j)*eello_t4/fac_shield(j)
3690 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3691 cd & ' eello_turn4_num',8*eello_turn4_num
3693 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3694 & -(gs13+gsE13+gsEE1)*wturn4
3695 & *fac_shield(i)*fac_shield(j)
3696 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3697 & -(gs23+gs21+gsEE2)*wturn4
3698 & *fac_shield(i)*fac_shield(j)
3700 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3701 & -(gs32+gsE31+gsEE3)*wturn4
3702 & *fac_shield(i)*fac_shield(j)
3704 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3707 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3708 & 'eturn4',i,j,-(s1+s2+s3)
3709 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3710 c & ' eello_turn4_num',8*eello_turn4_num
3711 C Derivatives in gamma(i)
3712 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3713 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3714 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3715 s1=scalar2(b1(1,i+2),auxvec(1))
3716 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3717 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3718 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3719 & *fac_shield(i)*fac_shield(j)*faclipij
3720 C Derivatives in gamma(i+1)
3721 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3722 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3723 s2=scalar2(b1(1,i+1),auxvec(1))
3724 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3725 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3726 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3727 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3728 & *fac_shield(i)*fac_shield(j)*faclipij
3729 C Derivatives in gamma(i+2)
3730 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3731 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3732 s1=scalar2(b1(1,i+2),auxvec(1))
3733 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3734 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3735 s2=scalar2(b1(1,i+1),auxvec(1))
3736 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3737 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3738 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3739 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3740 & *fac_shield(i)*fac_shield(j)*faclipij
3742 C Cartesian derivatives
3743 C Derivatives of this turn contributions in DC(i+2)
3744 if (j.lt.nres-1) then
3746 a_temp(1,1)=agg(l,1)
3747 a_temp(1,2)=agg(l,2)
3748 a_temp(2,1)=agg(l,3)
3749 a_temp(2,2)=agg(l,4)
3750 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3751 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3752 s1=scalar2(b1(1,i+2),auxvec(1))
3753 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3754 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3755 s2=scalar2(b1(1,i+1),auxvec(1))
3756 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3757 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3758 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3760 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3761 & *fac_shield(i)*fac_shield(j)*faclipij
3764 C Remaining derivatives of this turn contribution
3766 a_temp(1,1)=aggi(l,1)
3767 a_temp(1,2)=aggi(l,2)
3768 a_temp(2,1)=aggi(l,3)
3769 a_temp(2,2)=aggi(l,4)
3770 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3771 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3772 s1=scalar2(b1(1,i+2),auxvec(1))
3773 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3774 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3775 s2=scalar2(b1(1,i+1),auxvec(1))
3776 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3777 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3778 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3779 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3780 & *fac_shield(i)*fac_shield(j)*faclipij
3781 a_temp(1,1)=aggi1(l,1)
3782 a_temp(1,2)=aggi1(l,2)
3783 a_temp(2,1)=aggi1(l,3)
3784 a_temp(2,2)=aggi1(l,4)
3785 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3786 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3787 s1=scalar2(b1(1,i+2),auxvec(1))
3788 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3789 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3790 s2=scalar2(b1(1,i+1),auxvec(1))
3791 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3792 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3793 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3794 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3795 & *fac_shield(i)*fac_shield(j)*faclipij
3796 a_temp(1,1)=aggj(l,1)
3797 a_temp(1,2)=aggj(l,2)
3798 a_temp(2,1)=aggj(l,3)
3799 a_temp(2,2)=aggj(l,4)
3800 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3801 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3802 s1=scalar2(b1(1,i+2),auxvec(1))
3803 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3804 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3805 s2=scalar2(b1(1,i+1),auxvec(1))
3806 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3807 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3808 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3809 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3810 & *fac_shield(i)*fac_shield(j)*faclipij
3811 a_temp(1,1)=aggj1(l,1)
3812 a_temp(1,2)=aggj1(l,2)
3813 a_temp(2,1)=aggj1(l,3)
3814 a_temp(2,2)=aggj1(l,4)
3815 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3816 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3817 s1=scalar2(b1(1,i+2),auxvec(1))
3818 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3819 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3820 s2=scalar2(b1(1,i+1),auxvec(1))
3821 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3822 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3823 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3824 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3825 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3826 & *fac_shield(i)*fac_shield(j)*faclipij
3833 C-----------------------------------------------------------------------------
3834 subroutine vecpr(u,v,w)
3835 implicit real*8(a-h,o-z)
3836 dimension u(3),v(3),w(3)
3837 w(1)=u(2)*v(3)-u(3)*v(2)
3838 w(2)=-u(1)*v(3)+u(3)*v(1)
3839 w(3)=u(1)*v(2)-u(2)*v(1)
3842 C-----------------------------------------------------------------------------
3843 subroutine unormderiv(u,ugrad,unorm,ungrad)
3844 C This subroutine computes the derivatives of a normalized vector u, given
3845 C the derivatives computed without normalization conditions, ugrad. Returns
3848 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3849 double precision vec(3)
3850 double precision scalar
3852 c write (2,*) 'ugrad',ugrad
3855 vec(i)=scalar(ugrad(1,i),u(1))
3857 c write (2,*) 'vec',vec
3860 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3863 c write (2,*) 'ungrad',ungrad
3866 C-----------------------------------------------------------------------------
3867 subroutine escp(evdw2,evdw2_14)
3869 C This subroutine calculates the excluded-volume interaction energy between
3870 C peptide-group centers and side chains and its gradient in virtual-bond and
3871 C side-chain vectors.
3873 implicit real*8 (a-h,o-z)
3874 include 'DIMENSIONS'
3875 include 'COMMON.GEO'
3876 include 'COMMON.VAR'
3877 include 'COMMON.LOCAL'
3878 include 'COMMON.CHAIN'
3879 include 'COMMON.DERIV'
3880 include 'COMMON.INTERACT'
3881 include 'COMMON.FFIELD'
3882 include 'COMMON.IOUNITS'
3886 cd print '(a)','Enter ESCP'
3887 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3888 c & ' scal14',scal14
3889 do i=iatscp_s,iatscp_e
3890 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3892 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3893 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3894 if (iteli.eq.0) goto 1225
3895 xi=0.5D0*(c(1,i)+c(1,i+1))
3896 yi=0.5D0*(c(2,i)+c(2,i+1))
3897 zi=0.5D0*(c(3,i)+c(3,i+1))
3898 C Returning the ith atom to box
3899 call to_box(xi,yi,zi)
3900 do iint=1,nscp_gr(i)
3902 do j=iscpstart(i,iint),iscpend(i,iint)
3903 itypj=iabs(itype(j))
3904 if (itypj.eq.ntyp1) cycle
3905 C Uncomment following three lines for SC-p interactions
3909 C Uncomment following three lines for Ca-p interactions
3913 C returning the jth atom to box
3914 call to_box(xj,yj,zj)
3915 xj=boxshift(xj-xi,boxxsize)
3916 yj=boxshift(yj-yi,boxysize)
3917 zj=boxshift(zj-zi,boxzsize)
3918 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3919 C sss is scaling function for smoothing the cutoff gradient otherwise
3920 C the gradient would not be continuouse
3921 sss=sscale(1.0d0/(dsqrt(rrij)))
3922 if (sss.le.0.0d0) cycle
3923 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3925 e1=fac*fac*aad(itypj,iteli)
3926 e2=fac*bad(itypj,iteli)
3927 if (iabs(j-i) .le. 2) then
3930 evdw2_14=evdw2_14+(e1+e2)*sss
3933 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3934 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3935 c & bad(itypj,iteli)
3936 evdw2=evdw2+evdwij*sss
3939 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3941 fac=-(evdwij+e1)*rrij*sss
3942 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3947 cd write (iout,*) 'j<i'
3948 C Uncomment following three lines for SC-p interactions
3950 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3953 cd write (iout,*) 'j>i'
3956 C Uncomment following line for SC-p interactions
3957 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3961 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3965 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3966 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3969 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3979 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3980 gradx_scp(j,i)=expon*gradx_scp(j,i)
3983 C******************************************************************************
3987 C To save time the factor EXPON has been extracted from ALL components
3988 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3991 C******************************************************************************
3994 C--------------------------------------------------------------------------
3995 subroutine edis(ehpb)
3997 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3999 implicit real*8 (a-h,o-z)
4000 include 'DIMENSIONS'
4001 include 'COMMON.SBRIDGE'
4002 include 'COMMON.CHAIN'
4003 include 'COMMON.DERIV'
4004 include 'COMMON.VAR'
4005 include 'COMMON.INTERACT'
4006 include 'COMMON.CONTROL'
4007 include 'COMMON.IOUNITS'
4008 dimension ggg(3),ggg_peak(3,1000)
4011 c 8/21/18 AL: added explicit restraints on reference coords
4012 c write (iout,*) "restr_on_coord",restr_on_coord
4013 if (restr_on_coord) then
4017 if (itype(i).eq.ntyp1) cycle
4019 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4020 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4022 if (itype(i).ne.10) then
4024 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4025 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4028 if (energy_dec) write (iout,*)
4029 & "i",i," bfac",bfac(i)," ecoor",ecoor
4030 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4034 C write (iout,*) ,"link_end",link_end,constr_dist
4035 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4036 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4037 c & " constr_dist",constr_dist
4038 if (link_end.eq.0.and.link_end_peak.eq.0) return
4039 do i=link_start_peak,link_end_peak
4041 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4042 c & ipeak(1,i),ipeak(2,i)
4043 do ip=ipeak(1,i),ipeak(2,i)
4048 C iii and jjj point to the residues for which the distance is assigned.
4049 c if (ii.gt.nres) then
4056 if (ii.gt.nres) then
4061 if (jj.gt.nres) then
4066 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4067 aux=dexp(-scal_peak*aux)
4068 ehpb_peak=ehpb_peak+aux
4069 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4070 & forcon_peak(ip))*aux/dd
4072 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4074 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4075 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4076 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4078 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4079 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4080 do ip=ipeak(1,i),ipeak(2,i)
4083 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4087 C iii and jjj point to the residues for which the distance is assigned.
4088 c if (ii.gt.nres) then
4095 if (ii.gt.nres) then
4100 if (jj.gt.nres) then
4107 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4112 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4116 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4117 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4121 do i=link_start,link_end
4122 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4123 C CA-CA distance used in regularization of structure.
4126 C iii and jjj point to the residues for which the distance is assigned.
4127 c if (ii.gt.nres) then
4134 if (ii.gt.nres) then
4139 if (jj.gt.nres) then
4144 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4145 c & dhpb(i),dhpb1(i),forcon(i)
4146 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4147 C distance and angle dependent SS bond potential.
4148 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4149 C & iabs(itype(jjj)).eq.1) then
4150 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4151 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4152 if (.not.dyn_ss .and. i.le.nss) then
4153 C 15/02/13 CC dynamic SSbond - additional check
4154 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4155 & iabs(itype(jjj)).eq.1) then
4156 call ssbond_ene(iii,jjj,eij)
4159 cd write (iout,*) "eij",eij
4160 cd & ' waga=',waga,' fac=',fac
4161 ! else if (ii.gt.nres .and. jj.gt.nres) then
4163 C Calculate the distance between the two points and its difference from the
4166 if (irestr_type(i).eq.11) then
4167 ehpb=ehpb+fordepth(i)!**4.0d0
4168 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4169 fac=fordepth(i)!**4.0d0
4170 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4171 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4172 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4173 & ehpb,irestr_type(i)
4174 else if (irestr_type(i).eq.10) then
4175 c AL 6//19/2018 cross-link restraints
4176 xdis = 0.5d0*(dd/forcon(i))**2
4177 expdis = dexp(-xdis)
4178 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4179 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4180 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4181 c & " wboltzd",wboltzd
4182 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4183 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4184 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4185 & *expdis/(aux*forcon(i)**2)
4186 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4187 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4188 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4189 else if (irestr_type(i).eq.2) then
4190 c Quartic restraints
4191 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4192 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4193 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4194 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4195 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4197 c Quadratic restraints
4199 C Get the force constant corresponding to this distance.
4201 C Calculate the contribution to energy.
4202 ehpb=ehpb+0.5d0*waga*rdis*rdis
4203 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4204 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4205 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4207 C Evaluate gradient.
4211 c Calculate Cartesian gradient
4213 ggg(j)=fac*(c(j,jj)-c(j,ii))
4215 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4216 C If this is a SC-SC distance, we need to calculate the contributions to the
4217 C Cartesian gradient in the SC vectors (ghpbx).
4220 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4225 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4229 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4230 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4236 C--------------------------------------------------------------------------
4237 subroutine ssbond_ene(i,j,eij)
4239 C Calculate the distance and angle dependent SS-bond potential energy
4240 C using a free-energy function derived based on RHF/6-31G** ab initio
4241 C calculations of diethyl disulfide.
4243 C A. Liwo and U. Kozlowska, 11/24/03
4245 implicit real*8 (a-h,o-z)
4246 include 'DIMENSIONS'
4247 include 'COMMON.SBRIDGE'
4248 include 'COMMON.CHAIN'
4249 include 'COMMON.DERIV'
4250 include 'COMMON.LOCAL'
4251 include 'COMMON.INTERACT'
4252 include 'COMMON.VAR'
4253 include 'COMMON.IOUNITS'
4254 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4255 itypi=iabs(itype(i))
4259 dxi=dc_norm(1,nres+i)
4260 dyi=dc_norm(2,nres+i)
4261 dzi=dc_norm(3,nres+i)
4262 dsci_inv=dsc_inv(itypi)
4263 itypj=iabs(itype(j))
4264 dscj_inv=dsc_inv(itypj)
4268 dxj=dc_norm(1,nres+j)
4269 dyj=dc_norm(2,nres+j)
4270 dzj=dc_norm(3,nres+j)
4271 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4276 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4277 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4278 om12=dxi*dxj+dyi*dyj+dzi*dzj
4280 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4281 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4287 deltat12=om2-om1+2.0d0
4289 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4290 & +akct*deltad*deltat12
4291 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4292 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4293 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4294 c & " deltat12",deltat12," eij",eij
4295 ed=2*akcm*deltad+akct*deltat12
4297 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4298 eom1=-2*akth*deltat1-pom1-om2*pom2
4299 eom2= 2*akth*deltat2+pom1-om1*pom2
4302 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4305 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4306 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4307 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4308 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4311 C Calculate the components of the gradient in DC and X
4315 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4320 C--------------------------------------------------------------------------
4321 subroutine ebond(estr)
4323 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4325 implicit real*8 (a-h,o-z)
4326 include 'DIMENSIONS'
4327 include 'COMMON.LOCAL'
4328 include 'COMMON.GEO'
4329 include 'COMMON.INTERACT'
4330 include 'COMMON.DERIV'
4331 include 'COMMON.VAR'
4332 include 'COMMON.CHAIN'
4333 include 'COMMON.IOUNITS'
4334 include 'COMMON.NAMES'
4335 include 'COMMON.FFIELD'
4336 include 'COMMON.CONTROL'
4337 double precision u(3),ud(3)
4340 c write (iout,*) "distchainmax",distchainmax
4343 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
4344 diff = vbld(i)-vbldp0
4346 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4347 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4349 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4350 C & *dc(j,i-1)/vbld(i)
4352 C if (energy_dec) write(iout,*)
4353 C & "estr1",i,vbld(i),distchainmax,
4354 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4356 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4357 diff = vbld(i)-vbldpDUM
4358 C write(iout,*) i,diff
4360 diff = vbld(i)-vbldp0
4361 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4364 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4365 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4368 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4371 C write (iout,'(a7,i5,4f7.3)')
4372 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4374 estr=0.5d0*AKP*estr+estr1
4376 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4380 if (iti.ne.10 .and. iti.ne.ntyp1) then
4383 diff=vbld(i+nres)-vbldsc0(1,iti)
4384 if (energy_dec) write (iout,*)
4385 & i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4386 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4387 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4389 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4393 diff=vbld(i+nres)-vbldsc0(j,iti)
4394 ud(j)=aksc(j,iti)*diff
4395 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4409 uprod2=uprod2*u(k)*u(k)
4413 usumsqder=usumsqder+ud(j)*uprod2
4415 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4416 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4417 estr=estr+uprod/usum
4419 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4427 C--------------------------------------------------------------------------
4428 subroutine ebend(etheta,ethetacnstr)
4430 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4431 C angles gamma and its derivatives in consecutive thetas and gammas.
4433 implicit real*8 (a-h,o-z)
4434 include 'DIMENSIONS'
4435 include 'COMMON.LOCAL'
4436 include 'COMMON.GEO'
4437 include 'COMMON.INTERACT'
4438 include 'COMMON.DERIV'
4439 include 'COMMON.VAR'
4440 include 'COMMON.CHAIN'
4441 include 'COMMON.IOUNITS'
4442 include 'COMMON.NAMES'
4443 include 'COMMON.FFIELD'
4444 include 'COMMON.TORCNSTR'
4445 common /calcthet/ term1,term2,termm,diffak,ratak,
4446 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4447 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4448 double precision y(2),z(2)
4450 c time11=dexp(-2*time)
4453 c write (iout,*) "nres",nres
4454 c write (*,'(a,i2)') 'EBEND ICG=',icg
4455 c write (iout,*) ithet_start,ithet_end
4456 do i=ithet_start,ithet_end
4457 C if (itype(i-1).eq.ntyp1) cycle
4459 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4460 & .or.itype(i).eq.ntyp1) cycle
4461 C Zero the energy function and its derivative at 0 or pi.
4462 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4464 ichir1=isign(1,itype(i-2))
4465 ichir2=isign(1,itype(i))
4466 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4467 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4468 if (itype(i-1).eq.10) then
4469 itype1=isign(10,itype(i-2))
4470 ichir11=isign(1,itype(i-2))
4471 ichir12=isign(1,itype(i-2))
4472 itype2=isign(10,itype(i))
4473 ichir21=isign(1,itype(i))
4474 ichir22=isign(1,itype(i))
4481 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4485 c call proc_proc(phii,icrc)
4486 if (icrc.eq.1) phii=150.0
4497 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4501 c call proc_proc(phii1,icrc)
4502 if (icrc.eq.1) phii1=150.0
4514 C Calculate the "mean" value of theta from the part of the distribution
4515 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4516 C In following comments this theta will be referred to as t_c.
4517 thet_pred_mean=0.0d0
4519 athetk=athet(k,it,ichir1,ichir2)
4520 bthetk=bthet(k,it,ichir1,ichir2)
4522 athetk=athet(k,itype1,ichir11,ichir12)
4523 bthetk=bthet(k,itype2,ichir21,ichir22)
4525 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4527 c write (iout,*) "thet_pred_mean",thet_pred_mean
4528 dthett=thet_pred_mean*ssd
4529 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4530 c write (iout,*) "thet_pred_mean",thet_pred_mean
4531 C Derivatives of the "mean" values in gamma1 and gamma2.
4532 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4533 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4534 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4535 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4537 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4538 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4539 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4540 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4542 if (theta(i).gt.pi-delta) then
4543 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4545 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4546 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4547 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4549 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4551 else if (theta(i).lt.delta) then
4552 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4553 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4554 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4556 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4557 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4560 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4563 etheta=etheta+ethetai
4564 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4565 c & 'ebend',i,ethetai,theta(i),itype(i)
4566 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4567 c & rad2deg*phii,rad2deg*phii1,ethetai
4568 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4569 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4570 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4574 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4575 do i=1,ntheta_constr
4576 itheta=itheta_constr(i)
4577 thetiii=theta(itheta)
4578 difi=pinorm(thetiii-theta_constr0(i))
4579 if (difi.gt.theta_drange(i)) then
4580 difi=difi-theta_drange(i)
4581 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4582 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4583 & +for_thet_constr(i)*difi**3
4584 else if (difi.lt.-drange(i)) then
4586 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4587 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4588 & +for_thet_constr(i)*difi**3
4592 C if (energy_dec) then
4593 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4594 C & i,itheta,rad2deg*thetiii,
4595 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4596 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4597 C & gloc(itheta+nphi-2,icg)
4600 C Ufff.... We've done all this!!!
4603 C---------------------------------------------------------------------------
4604 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4606 implicit real*8 (a-h,o-z)
4607 include 'DIMENSIONS'
4608 include 'COMMON.LOCAL'
4609 include 'COMMON.IOUNITS'
4610 common /calcthet/ term1,term2,termm,diffak,ratak,
4611 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4612 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4613 C Calculate the contributions to both Gaussian lobes.
4614 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4615 C The "polynomial part" of the "standard deviation" of this part of
4619 sig=sig*thet_pred_mean+polthet(j,it)
4621 C Derivative of the "interior part" of the "standard deviation of the"
4622 C gamma-dependent Gaussian lobe in t_c.
4623 sigtc=3*polthet(3,it)
4625 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4628 C Set the parameters of both Gaussian lobes of the distribution.
4629 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4630 fac=sig*sig+sigc0(it)
4633 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4634 sigsqtc=-4.0D0*sigcsq*sigtc
4635 c print *,i,sig,sigtc,sigsqtc
4636 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4637 sigtc=-sigtc/(fac*fac)
4638 C Following variable is sigma(t_c)**(-2)
4639 sigcsq=sigcsq*sigcsq
4641 sig0inv=1.0D0/sig0i**2
4642 delthec=thetai-thet_pred_mean
4643 delthe0=thetai-theta0i
4644 term1=-0.5D0*sigcsq*delthec*delthec
4645 term2=-0.5D0*sig0inv*delthe0*delthe0
4646 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4647 C NaNs in taking the logarithm. We extract the largest exponent which is added
4648 C to the energy (this being the log of the distribution) at the end of energy
4649 C term evaluation for this virtual-bond angle.
4650 if (term1.gt.term2) then
4652 term2=dexp(term2-termm)
4656 term1=dexp(term1-termm)
4659 C The ratio between the gamma-independent and gamma-dependent lobes of
4660 C the distribution is a Gaussian function of thet_pred_mean too.
4661 diffak=gthet(2,it)-thet_pred_mean
4662 ratak=diffak/gthet(3,it)**2
4663 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4664 C Let's differentiate it in thet_pred_mean NOW.
4666 C Now put together the distribution terms to make complete distribution.
4667 termexp=term1+ak*term2
4668 termpre=sigc+ak*sig0i
4669 C Contribution of the bending energy from this theta is just the -log of
4670 C the sum of the contributions from the two lobes and the pre-exponential
4671 C factor. Simple enough, isn't it?
4672 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4673 C NOW the derivatives!!!
4674 C 6/6/97 Take into account the deformation.
4675 E_theta=(delthec*sigcsq*term1
4676 & +ak*delthe0*sig0inv*term2)/termexp
4677 E_tc=((sigtc+aktc*sig0i)/termpre
4678 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4679 & aktc*term2)/termexp)
4682 c-----------------------------------------------------------------------------
4683 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4684 implicit real*8 (a-h,o-z)
4685 include 'DIMENSIONS'
4686 include 'COMMON.LOCAL'
4687 include 'COMMON.IOUNITS'
4688 common /calcthet/ term1,term2,termm,diffak,ratak,
4689 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4690 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4691 delthec=thetai-thet_pred_mean
4692 delthe0=thetai-theta0i
4693 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4694 t3 = thetai-thet_pred_mean
4698 t14 = t12+t6*sigsqtc
4700 t21 = thetai-theta0i
4706 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4707 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4708 & *(-t12*t9-ak*sig0inv*t27)
4712 C--------------------------------------------------------------------------
4713 subroutine ebend(etheta)
4715 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4716 C angles gamma and its derivatives in consecutive thetas and gammas.
4717 C ab initio-derived potentials from
4718 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4720 implicit real*8 (a-h,o-z)
4721 include 'DIMENSIONS'
4722 include 'COMMON.LOCAL'
4723 include 'COMMON.GEO'
4724 include 'COMMON.INTERACT'
4725 include 'COMMON.DERIV'
4726 include 'COMMON.VAR'
4727 include 'COMMON.CHAIN'
4728 include 'COMMON.IOUNITS'
4729 include 'COMMON.NAMES'
4730 include 'COMMON.FFIELD'
4731 include 'COMMON.CONTROL'
4732 include 'COMMON.TORCNSTR'
4733 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4734 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4735 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4736 & sinph1ph2(maxdouble,maxdouble)
4737 logical lprn /.false./, lprn1 /.false./
4739 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4740 do i=ithet_start,ithet_end
4742 C if (itype(i-1).eq.ntyp1) cycle
4744 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4745 & .or.itype(i).eq.ntyp1) cycle
4746 if (iabs(itype(i+1)).eq.20) iblock=2
4747 if (iabs(itype(i+1)).ne.20) iblock=1
4751 theti2=0.5d0*theta(i)
4752 ityp2=ithetyp((itype(i-1)))
4754 coskt(k)=dcos(k*theti2)
4755 sinkt(k)=dsin(k*theti2)
4765 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4768 if (phii.ne.phii) phii=150.0
4772 ityp1=ithetyp((itype(i-2)))
4774 cosph1(k)=dcos(k*phii)
4775 sinph1(k)=dsin(k*phii)
4781 ityp1=ithetyp((itype(i-2)))
4786 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4789 if (phii1.ne.phii1) phii1=150.0
4794 ityp3=ithetyp((itype(i)))
4796 cosph2(k)=dcos(k*phii1)
4797 sinph2(k)=dsin(k*phii1)
4802 ityp3=ithetyp((itype(i)))
4808 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4809 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4811 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4814 ccl=cosph1(l)*cosph2(k-l)
4815 ssl=sinph1(l)*sinph2(k-l)
4816 scl=sinph1(l)*cosph2(k-l)
4817 csl=cosph1(l)*sinph2(k-l)
4818 cosph1ph2(l,k)=ccl-ssl
4819 cosph1ph2(k,l)=ccl+ssl
4820 sinph1ph2(l,k)=scl+csl
4821 sinph1ph2(k,l)=scl-csl
4825 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4826 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4827 write (iout,*) "coskt and sinkt"
4829 write (iout,*) k,coskt(k),sinkt(k)
4833 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4834 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4837 & write (iout,*) "k",k,"
4838 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4839 & " ethetai",ethetai
4842 write (iout,*) "cosph and sinph"
4844 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4846 write (iout,*) "cosph1ph2 and sinph2ph2"
4849 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4850 & sinph1ph2(l,k),sinph1ph2(k,l)
4853 write(iout,*) "ethetai",ethetai
4857 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4858 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4859 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4860 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4861 ethetai=ethetai+sinkt(m)*aux
4862 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4863 dephii=dephii+k*sinkt(m)*(
4864 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4865 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4866 dephii1=dephii1+k*sinkt(m)*(
4867 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4868 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4870 & write (iout,*) "m",m," k",k," bbthet",
4871 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4872 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4873 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4874 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4878 & write(iout,*) "ethetai",ethetai
4882 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4883 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4884 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4885 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4886 ethetai=ethetai+sinkt(m)*aux
4887 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4888 dephii=dephii+l*sinkt(m)*(
4889 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4890 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4891 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4892 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4893 dephii1=dephii1+(k-l)*sinkt(m)*(
4894 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4895 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4896 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4897 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4899 write (iout,*) "m",m," k",k," l",l," ffthet",
4900 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4901 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4902 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4903 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4904 & " ethetai",ethetai
4905 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4906 & cosph1ph2(k,l)*sinkt(m),
4907 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4913 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4914 & i,theta(i)*rad2deg,phii*rad2deg,
4915 & phii1*rad2deg,ethetai
4916 etheta=etheta+ethetai
4917 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4918 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4919 c gloc(nphi+i-2,icg)=wang*dethetai
4920 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4926 c-----------------------------------------------------------------------------
4927 subroutine esc(escloc)
4928 C Calculate the local energy of a side chain and its derivatives in the
4929 C corresponding virtual-bond valence angles THETA and the spherical angles
4931 implicit real*8 (a-h,o-z)
4932 include 'DIMENSIONS'
4933 include 'COMMON.GEO'
4934 include 'COMMON.LOCAL'
4935 include 'COMMON.VAR'
4936 include 'COMMON.INTERACT'
4937 include 'COMMON.DERIV'
4938 include 'COMMON.CHAIN'
4939 include 'COMMON.IOUNITS'
4940 include 'COMMON.NAMES'
4941 include 'COMMON.FFIELD'
4942 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4943 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4944 common /sccalc/ time11,time12,time112,theti,it,nlobit
4947 C write (iout,*) 'ESC'
4948 do i=loc_start,loc_end
4950 if (it.eq.ntyp1) cycle
4951 if (it.eq.10) goto 1
4952 nlobit=nlob(iabs(it))
4953 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4954 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4955 theti=theta(i+1)-pipol
4959 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4961 if (x(2).gt.pi-delta) then
4965 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4967 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4968 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4970 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4971 & ddersc0(1),dersc(1))
4972 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4973 & ddersc0(3),dersc(3))
4975 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4977 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4978 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4979 & dersc0(2),esclocbi,dersc02)
4980 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4982 call splinthet(x(2),0.5d0*delta,ss,ssd)
4987 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4989 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4990 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4992 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4994 c write (iout,*) escloci
4995 else if (x(2).lt.delta) then
4999 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5001 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5002 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5004 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5005 & ddersc0(1),dersc(1))
5006 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5007 & ddersc0(3),dersc(3))
5009 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5011 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5012 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5013 & dersc0(2),esclocbi,dersc02)
5014 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5019 call splinthet(x(2),0.5d0*delta,ss,ssd)
5021 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5023 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5024 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5026 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5027 C write (iout,*) 'i=',i, escloci
5029 call enesc(x,escloci,dersc,ddummy,.false.)
5032 escloc=escloc+escloci
5033 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5034 write (iout,'(a6,i5,0pf7.3)')
5035 & 'escloc',i,escloci
5037 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5039 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5040 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5045 C---------------------------------------------------------------------------
5046 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5047 implicit real*8 (a-h,o-z)
5048 include 'DIMENSIONS'
5049 include 'COMMON.GEO'
5050 include 'COMMON.LOCAL'
5051 include 'COMMON.IOUNITS'
5052 common /sccalc/ time11,time12,time112,theti,it,nlobit
5053 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5054 double precision contr(maxlob,-1:1)
5056 c write (iout,*) 'it=',it,' nlobit=',nlobit
5060 if (mixed) ddersc(j)=0.0d0
5064 C Because of periodicity of the dependence of the SC energy in omega we have
5065 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5066 C To avoid underflows, first compute & store the exponents.
5074 z(k)=x(k)-censc(k,j,it)
5079 Axk=Axk+gaussc(l,k,j,it)*z(l)
5085 expfac=expfac+Ax(k,j,iii)*z(k)
5093 C As in the case of ebend, we want to avoid underflows in exponentiation and
5094 C subsequent NaNs and INFs in energy calculation.
5095 C Find the largest exponent
5099 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5103 cd print *,'it=',it,' emin=',emin
5105 C Compute the contribution to SC energy and derivatives
5109 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5110 cd print *,'j=',j,' expfac=',expfac
5111 escloc_i=escloc_i+expfac
5113 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5117 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5118 & +gaussc(k,2,j,it))*expfac
5125 dersc(1)=dersc(1)/cos(theti)**2
5126 ddersc(1)=ddersc(1)/cos(theti)**2
5129 escloci=-(dlog(escloc_i)-emin)
5131 dersc(j)=dersc(j)/escloc_i
5135 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5140 C------------------------------------------------------------------------------
5141 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5142 implicit real*8 (a-h,o-z)
5143 include 'DIMENSIONS'
5144 include 'COMMON.GEO'
5145 include 'COMMON.LOCAL'
5146 include 'COMMON.IOUNITS'
5147 common /sccalc/ time11,time12,time112,theti,it,nlobit
5148 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5149 double precision contr(maxlob)
5160 z(k)=x(k)-censc(k,j,it)
5166 Axk=Axk+gaussc(l,k,j,it)*z(l)
5172 expfac=expfac+Ax(k,j)*z(k)
5177 C As in the case of ebend, we want to avoid underflows in exponentiation and
5178 C subsequent NaNs and INFs in energy calculation.
5179 C Find the largest exponent
5182 if (emin.gt.contr(j)) emin=contr(j)
5186 C Compute the contribution to SC energy and derivatives
5190 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5191 escloc_i=escloc_i+expfac
5193 dersc(k)=dersc(k)+Ax(k,j)*expfac
5195 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5196 & +gaussc(1,2,j,it))*expfac
5200 dersc(1)=dersc(1)/cos(theti)**2
5201 dersc12=dersc12/cos(theti)**2
5202 escloci=-(dlog(escloc_i)-emin)
5204 dersc(j)=dersc(j)/escloc_i
5206 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5210 c----------------------------------------------------------------------------------
5211 subroutine esc(escloc)
5212 C Calculate the local energy of a side chain and its derivatives in the
5213 C corresponding virtual-bond valence angles THETA and the spherical angles
5214 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5215 C added by Urszula Kozlowska. 07/11/2007
5217 implicit real*8 (a-h,o-z)
5218 include 'DIMENSIONS'
5219 include 'COMMON.GEO'
5220 include 'COMMON.LOCAL'
5221 include 'COMMON.VAR'
5222 include 'COMMON.SCROT'
5223 include 'COMMON.INTERACT'
5224 include 'COMMON.DERIV'
5225 include 'COMMON.CHAIN'
5226 include 'COMMON.IOUNITS'
5227 include 'COMMON.NAMES'
5228 include 'COMMON.FFIELD'
5229 include 'COMMON.CONTROL'
5230 include 'COMMON.VECTORS'
5231 double precision x_prime(3),y_prime(3),z_prime(3)
5232 & , sumene,dsc_i,dp2_i,x(65),
5233 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5234 & de_dxx,de_dyy,de_dzz,de_dt
5235 double precision s1_t,s1_6_t,s2_t,s2_6_t
5237 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5238 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5239 & dt_dCi(3),dt_dCi1(3)
5240 common /sccalc/ time11,time12,time112,theti,it,nlobit
5243 do i=loc_start,loc_end
5244 if (itype(i).eq.ntyp1) cycle
5245 costtab(i+1) =dcos(theta(i+1))
5246 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5247 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5248 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5249 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5250 cosfac=dsqrt(cosfac2)
5251 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5252 sinfac=dsqrt(sinfac2)
5254 if (it.eq.10) goto 1
5256 C Compute the axes of tghe local cartesian coordinates system; store in
5257 c x_prime, y_prime and z_prime
5264 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5265 C & dc_norm(3,i+nres)
5267 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5268 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5271 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5274 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5275 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5276 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5277 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5278 c & " xy",scalar(x_prime(1),y_prime(1)),
5279 c & " xz",scalar(x_prime(1),z_prime(1)),
5280 c & " yy",scalar(y_prime(1),y_prime(1)),
5281 c & " yz",scalar(y_prime(1),z_prime(1)),
5282 c & " zz",scalar(z_prime(1),z_prime(1))
5284 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5285 C to local coordinate system. Store in xx, yy, zz.
5291 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5292 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5293 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5300 C Compute the energy of the ith side cbain
5302 c write (2,*) "xx",xx," yy",yy," zz",zz
5305 x(j) = sc_parmin(j,it)
5308 Cc diagnostics - remove later
5310 yy1 = dsin(alph(2))*dcos(omeg(2))
5311 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5312 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5313 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5315 C," --- ", xx_w,yy_w,zz_w
5318 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5319 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5321 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5322 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5324 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5325 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5326 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5327 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5328 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5330 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5331 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5332 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5333 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5334 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5336 dsc_i = 0.743d0+x(61)
5338 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5339 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5340 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5341 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5342 s1=(1+x(63))/(0.1d0 + dscp1)
5343 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5344 s2=(1+x(65))/(0.1d0 + dscp2)
5345 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5346 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5347 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5348 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5350 c & dscp1,dscp2,sumene
5351 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5352 escloc = escloc + sumene
5353 c write (2,*) "escloc",escloc
5354 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5356 if (.not. calc_grad) goto 1
5359 C This section to check the numerical derivatives of the energy of ith side
5360 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5361 C #define DEBUG in the code to turn it on.
5363 write (2,*) "sumene =",sumene
5367 write (2,*) xx,yy,zz
5368 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5369 de_dxx_num=(sumenep-sumene)/aincr
5371 write (2,*) "xx+ sumene from enesc=",sumenep
5374 write (2,*) xx,yy,zz
5375 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5376 de_dyy_num=(sumenep-sumene)/aincr
5378 write (2,*) "yy+ sumene from enesc=",sumenep
5381 write (2,*) xx,yy,zz
5382 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5383 de_dzz_num=(sumenep-sumene)/aincr
5385 write (2,*) "zz+ sumene from enesc=",sumenep
5386 costsave=cost2tab(i+1)
5387 sintsave=sint2tab(i+1)
5388 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5389 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5390 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5391 de_dt_num=(sumenep-sumene)/aincr
5392 write (2,*) " t+ sumene from enesc=",sumenep
5393 cost2tab(i+1)=costsave
5394 sint2tab(i+1)=sintsave
5395 C End of diagnostics section.
5398 C Compute the gradient of esc
5400 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5401 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5402 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5403 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5404 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5405 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5406 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5407 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5408 pom1=(sumene3*sint2tab(i+1)+sumene1)
5409 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5410 pom2=(sumene4*cost2tab(i+1)+sumene2)
5411 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5412 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5413 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5414 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5416 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5417 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5418 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5420 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5421 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5422 & +(pom1+pom2)*pom_dx
5424 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5427 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5428 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5429 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5431 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5432 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5433 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5434 & +x(59)*zz**2 +x(60)*xx*zz
5435 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5436 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5437 & +(pom1-pom2)*pom_dy
5439 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5442 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5443 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5444 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5445 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5446 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5447 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5448 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5449 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5451 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5454 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5455 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5456 & +pom1*pom_dt1+pom2*pom_dt2
5458 write(2,*), "de_dt = ", de_dt,de_dt_num
5462 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5463 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5464 cosfac2xx=cosfac2*xx
5465 sinfac2yy=sinfac2*yy
5467 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5469 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5471 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5472 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5473 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5474 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5475 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5476 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5477 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5478 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5479 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5480 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5484 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5485 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5486 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5487 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5490 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5491 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5492 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5494 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5495 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5499 dXX_Ctab(k,i)=dXX_Ci(k)
5500 dXX_C1tab(k,i)=dXX_Ci1(k)
5501 dYY_Ctab(k,i)=dYY_Ci(k)
5502 dYY_C1tab(k,i)=dYY_Ci1(k)
5503 dZZ_Ctab(k,i)=dZZ_Ci(k)
5504 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5505 dXX_XYZtab(k,i)=dXX_XYZ(k)
5506 dYY_XYZtab(k,i)=dYY_XYZ(k)
5507 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5511 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5512 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5513 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5514 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5515 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5517 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5518 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5519 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5520 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5521 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5522 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5523 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5524 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5526 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5527 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5529 C to check gradient call subroutine check_grad
5536 c------------------------------------------------------------------------------
5537 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5539 C This procedure calculates two-body contact function g(rij) and its derivative:
5542 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5545 C where x=(rij-r0ij)/delta
5547 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5550 double precision rij,r0ij,eps0ij,fcont,fprimcont
5551 double precision x,x2,x4,delta
5555 if (x.lt.-1.0D0) then
5558 else if (x.le.1.0D0) then
5561 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5562 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5569 c------------------------------------------------------------------------------
5570 subroutine splinthet(theti,delta,ss,ssder)
5571 implicit real*8 (a-h,o-z)
5572 include 'DIMENSIONS'
5573 include 'COMMON.VAR'
5574 include 'COMMON.GEO'
5577 if (theti.gt.pipol) then
5578 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5580 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5585 c------------------------------------------------------------------------------
5586 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5588 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5589 double precision ksi,ksi2,ksi3,a1,a2,a3
5590 a1=fprim0*delta/(f1-f0)
5596 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5597 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5600 c------------------------------------------------------------------------------
5601 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5603 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5604 double precision ksi,ksi2,ksi3,a1,a2,a3
5609 a2=3*(f1x-f0x)-2*fprim0x*delta
5610 a3=fprim0x*delta-2*(f1x-f0x)
5611 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5614 C-----------------------------------------------------------------------------
5616 C-----------------------------------------------------------------------------
5617 subroutine etor(etors,fact)
5618 implicit real*8 (a-h,o-z)
5619 include 'DIMENSIONS'
5620 include 'COMMON.VAR'
5621 include 'COMMON.GEO'
5622 include 'COMMON.LOCAL'
5623 include 'COMMON.TORSION'
5624 include 'COMMON.INTERACT'
5625 include 'COMMON.DERIV'
5626 include 'COMMON.CHAIN'
5627 include 'COMMON.NAMES'
5628 include 'COMMON.IOUNITS'
5629 include 'COMMON.FFIELD'
5630 include 'COMMON.TORCNSTR'
5632 C Set lprn=.true. for debugging
5636 do i=iphi_start,iphi_end
5637 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5638 & .or. itype(i).eq.ntyp1) cycle
5639 itori=itortyp(itype(i-2))
5640 itori1=itortyp(itype(i-1))
5643 C Proline-Proline pair is a special case...
5644 if (itori.eq.3 .and. itori1.eq.3) then
5645 if (phii.gt.-dwapi3) then
5647 fac=1.0D0/(1.0D0-cosphi)
5648 etorsi=v1(1,3,3)*fac
5649 etorsi=etorsi+etorsi
5650 etors=etors+etorsi-v1(1,3,3)
5651 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5654 v1ij=v1(j+1,itori,itori1)
5655 v2ij=v2(j+1,itori,itori1)
5658 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5659 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5663 v1ij=v1(j,itori,itori1)
5664 v2ij=v2(j,itori,itori1)
5667 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5668 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5672 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5673 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5674 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5675 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5676 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5680 c------------------------------------------------------------------------------
5682 subroutine etor(etors,fact)
5683 implicit real*8 (a-h,o-z)
5684 include 'DIMENSIONS'
5685 include 'COMMON.VAR'
5686 include 'COMMON.GEO'
5687 include 'COMMON.LOCAL'
5688 include 'COMMON.TORSION'
5689 include 'COMMON.INTERACT'
5690 include 'COMMON.DERIV'
5691 include 'COMMON.CHAIN'
5692 include 'COMMON.NAMES'
5693 include 'COMMON.IOUNITS'
5694 include 'COMMON.FFIELD'
5695 include 'COMMON.TORCNSTR'
5697 C Set lprn=.true. for debugging
5701 do i=iphi_start,iphi_end
5703 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5704 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5705 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5706 C & .or. itype(i).eq.ntyp1) cycle
5707 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5708 if (iabs(itype(i)).eq.20) then
5713 itori=itortyp(itype(i-2))
5714 itori1=itortyp(itype(i-1))
5717 C Regular cosine and sine terms
5718 do j=1,nterm(itori,itori1,iblock)
5719 v1ij=v1(j,itori,itori1,iblock)
5720 v2ij=v2(j,itori,itori1,iblock)
5723 etors=etors+v1ij*cosphi+v2ij*sinphi
5724 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5728 C E = SUM ----------------------------------- - v1
5729 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5731 cosphi=dcos(0.5d0*phii)
5732 sinphi=dsin(0.5d0*phii)
5733 do j=1,nlor(itori,itori1,iblock)
5734 vl1ij=vlor1(j,itori,itori1)
5735 vl2ij=vlor2(j,itori,itori1)
5736 vl3ij=vlor3(j,itori,itori1)
5737 pom=vl2ij*cosphi+vl3ij*sinphi
5738 pom1=1.0d0/(pom*pom+1.0d0)
5739 etors=etors+vl1ij*pom1
5740 c if (energy_dec) etors_ii=etors_ii+
5743 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5745 C Subtract the constant term
5746 etors=etors-v0(itori,itori1,iblock)
5748 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5749 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5750 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5751 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5752 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5757 c----------------------------------------------------------------------------
5758 subroutine etor_d(etors_d,fact2)
5759 C 6/23/01 Compute double torsional energy
5760 implicit real*8 (a-h,o-z)
5761 include 'DIMENSIONS'
5762 include 'COMMON.VAR'
5763 include 'COMMON.GEO'
5764 include 'COMMON.LOCAL'
5765 include 'COMMON.TORSION'
5766 include 'COMMON.INTERACT'
5767 include 'COMMON.DERIV'
5768 include 'COMMON.CHAIN'
5769 include 'COMMON.NAMES'
5770 include 'COMMON.IOUNITS'
5771 include 'COMMON.FFIELD'
5772 include 'COMMON.TORCNSTR'
5774 C Set lprn=.true. for debugging
5778 do i=iphi_start,iphi_end-1
5780 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5781 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5782 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5783 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5784 & (itype(i+1).eq.ntyp1)) cycle
5785 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5787 itori=itortyp(itype(i-2))
5788 itori1=itortyp(itype(i-1))
5789 itori2=itortyp(itype(i))
5795 if (iabs(itype(i+1)).eq.20) iblock=2
5796 C Regular cosine and sine terms
5797 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5798 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5799 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5800 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5801 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5802 cosphi1=dcos(j*phii)
5803 sinphi1=dsin(j*phii)
5804 cosphi2=dcos(j*phii1)
5805 sinphi2=dsin(j*phii1)
5806 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5807 & v2cij*cosphi2+v2sij*sinphi2
5808 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5809 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5811 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5813 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5814 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5815 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5816 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5817 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5818 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5819 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5820 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5821 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5822 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5823 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5824 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5825 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5826 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5829 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5830 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5836 c---------------------------------------------------------------------------
5837 C The rigorous attempt to derive energy function
5838 subroutine etor_kcc(etors,fact)
5839 implicit real*8 (a-h,o-z)
5840 include 'DIMENSIONS'
5841 include 'COMMON.VAR'
5842 include 'COMMON.GEO'
5843 include 'COMMON.LOCAL'
5844 include 'COMMON.TORSION'
5845 include 'COMMON.INTERACT'
5846 include 'COMMON.DERIV'
5847 include 'COMMON.CHAIN'
5848 include 'COMMON.NAMES'
5849 include 'COMMON.IOUNITS'
5850 include 'COMMON.FFIELD'
5851 include 'COMMON.TORCNSTR'
5852 include 'COMMON.CONTROL'
5853 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
5855 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
5856 C Set lprn=.true. for debugging
5859 C print *,"wchodze kcc"
5860 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
5862 do i=iphi_start,iphi_end
5863 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5864 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5865 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5866 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5867 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5868 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5869 itori=itortyp(itype(i-2))
5870 itori1=itortyp(itype(i-1))
5875 C to avoid multiple devision by 2
5876 c theti22=0.5d0*theta(i)
5877 C theta 12 is the theta_1 /2
5878 C theta 22 is theta_2 /2
5879 c theti12=0.5d0*theta(i-1)
5880 C and appropriate sinus function
5881 sinthet1=dsin(theta(i-1))
5882 sinthet2=dsin(theta(i))
5883 costhet1=dcos(theta(i-1))
5884 costhet2=dcos(theta(i))
5885 C to speed up lets store its mutliplication
5886 sint1t2=sinthet2*sinthet1
5888 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
5889 C +d_n*sin(n*gamma)) *
5890 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
5891 C we have two sum 1) Non-Chebyshev which is with n and gamma
5892 nval=nterm_kcc_Tb(itori,itori1)
5898 c1(j)=c1(j-1)*costhet1
5899 c2(j)=c2(j-1)*costhet2
5902 do j=1,nterm_kcc(itori,itori1)
5906 sint1t2n=sint1t2n*sint1t2
5912 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5913 gradvalct1=gradvalct1+
5914 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5915 gradvalct2=gradvalct2+
5916 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5919 gradvalct1=-gradvalct1*sinthet1
5920 gradvalct2=-gradvalct2*sinthet2
5926 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5927 gradvalst1=gradvalst1+
5928 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5929 gradvalst2=gradvalst2+
5930 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5933 gradvalst1=-gradvalst1*sinthet1
5934 gradvalst2=-gradvalst2*sinthet2
5935 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
5936 C glocig is the gradient local i site in gamma
5937 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
5938 C now gradient over theta_1
5939 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
5940 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
5941 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
5942 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
5945 C derivative over gamma
5946 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
5947 C derivative over theta1
5948 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
5949 C now derivative over theta2
5950 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
5952 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
5953 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
5957 c---------------------------------------------------------------------------------------------
5958 subroutine etor_constr(edihcnstr)
5959 implicit real*8 (a-h,o-z)
5960 include 'DIMENSIONS'
5961 include 'COMMON.VAR'
5962 include 'COMMON.GEO'
5963 include 'COMMON.LOCAL'
5964 include 'COMMON.TORSION'
5965 include 'COMMON.INTERACT'
5966 include 'COMMON.DERIV'
5967 include 'COMMON.CHAIN'
5968 include 'COMMON.NAMES'
5969 include 'COMMON.IOUNITS'
5970 include 'COMMON.FFIELD'
5971 include 'COMMON.TORCNSTR'
5972 include 'COMMON.CONTROL'
5973 ! 6/20/98 - dihedral angle constraints
5975 c do i=1,ndih_constr
5976 c write (iout,*) "idihconstr_start",idihconstr_start,
5977 c & " idihconstr_end",idihconstr_end
5978 if (raw_psipred) then
5979 do i=idihconstr_start,idihconstr_end
5980 itori=idih_constr(i)
5982 gaudih_i=vpsipred(1,i)
5986 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
5987 dexpcos_i=dexp(-cos_i*cos_i)
5988 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
5989 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
5990 & *cos_i*dexpcos_i/s**2
5992 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
5993 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
5995 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
5996 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
5997 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
5998 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
5999 & -wdihc*dlog(gaudih_i)
6002 do i=idihconstr_start,idihconstr_end
6003 itori=idih_constr(i)
6005 difi=pinorm(phii-phi0(i))
6006 if (difi.gt.drange(i)) then
6008 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6009 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6010 else if (difi.lt.-drange(i)) then
6012 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6013 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6021 c----------------------------------------------------------------------------
6022 C The rigorous attempt to derive energy function
6023 subroutine ebend_kcc(etheta)
6025 implicit real*8 (a-h,o-z)
6026 include 'DIMENSIONS'
6027 include 'COMMON.VAR'
6028 include 'COMMON.GEO'
6029 include 'COMMON.LOCAL'
6030 include 'COMMON.TORSION'
6031 include 'COMMON.INTERACT'
6032 include 'COMMON.DERIV'
6033 include 'COMMON.CHAIN'
6034 include 'COMMON.NAMES'
6035 include 'COMMON.IOUNITS'
6036 include 'COMMON.FFIELD'
6037 include 'COMMON.TORCNSTR'
6038 include 'COMMON.CONTROL'
6040 double precision thybt1(maxang_kcc)
6041 C Set lprn=.true. for debugging
6044 C print *,"wchodze kcc"
6045 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6047 do i=ithet_start,ithet_end
6048 c print *,i,itype(i-1),itype(i),itype(i-2)
6049 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6050 & .or.itype(i).eq.ntyp1) cycle
6051 iti=iabs(itortyp(itype(i-1)))
6052 sinthet=dsin(theta(i))
6053 costhet=dcos(theta(i))
6054 do j=1,nbend_kcc_Tb(iti)
6055 thybt1(j)=v1bend_chyb(j,iti)
6057 sumth1thyb=v1bend_chyb(0,iti)+
6058 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6059 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6061 ihelp=nbend_kcc_Tb(iti)-1
6062 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6063 etheta=etheta+sumth1thyb
6064 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6065 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6069 c-------------------------------------------------------------------------------------
6070 subroutine etheta_constr(ethetacnstr)
6072 implicit real*8 (a-h,o-z)
6073 include 'DIMENSIONS'
6074 include 'COMMON.VAR'
6075 include 'COMMON.GEO'
6076 include 'COMMON.LOCAL'
6077 include 'COMMON.TORSION'
6078 include 'COMMON.INTERACT'
6079 include 'COMMON.DERIV'
6080 include 'COMMON.CHAIN'
6081 include 'COMMON.NAMES'
6082 include 'COMMON.IOUNITS'
6083 include 'COMMON.FFIELD'
6084 include 'COMMON.TORCNSTR'
6085 include 'COMMON.CONTROL'
6087 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6088 do i=ithetaconstr_start,ithetaconstr_end
6089 itheta=itheta_constr(i)
6090 thetiii=theta(itheta)
6091 difi=pinorm(thetiii-theta_constr0(i))
6092 if (difi.gt.theta_drange(i)) then
6093 difi=difi-theta_drange(i)
6094 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6095 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6096 & +for_thet_constr(i)*difi**3
6097 else if (difi.lt.-drange(i)) then
6099 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6100 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6101 & +for_thet_constr(i)*difi**3
6105 if (energy_dec) then
6106 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6107 & i,itheta,rad2deg*thetiii,
6108 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6109 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6110 & gloc(itheta+nphi-2,icg)
6115 c------------------------------------------------------------------------------
6116 c------------------------------------------------------------------------------
6117 subroutine eback_sc_corr(esccor)
6118 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6119 c conformational states; temporarily implemented as differences
6120 c between UNRES torsional potentials (dependent on three types of
6121 c residues) and the torsional potentials dependent on all 20 types
6122 c of residues computed from AM1 energy surfaces of terminally-blocked
6123 c amino-acid residues.
6124 implicit real*8 (a-h,o-z)
6125 include 'DIMENSIONS'
6126 include 'COMMON.VAR'
6127 include 'COMMON.GEO'
6128 include 'COMMON.LOCAL'
6129 include 'COMMON.TORSION'
6130 include 'COMMON.SCCOR'
6131 include 'COMMON.INTERACT'
6132 include 'COMMON.DERIV'
6133 include 'COMMON.CHAIN'
6134 include 'COMMON.NAMES'
6135 include 'COMMON.IOUNITS'
6136 include 'COMMON.FFIELD'
6137 include 'COMMON.CONTROL'
6139 C Set lprn=.true. for debugging
6142 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6144 do i=itau_start,itau_end
6145 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6147 isccori=isccortyp(itype(i-2))
6148 isccori1=isccortyp(itype(i-1))
6150 do intertyp=1,3 !intertyp
6151 cc Added 09 May 2012 (Adasko)
6152 cc Intertyp means interaction type of backbone mainchain correlation:
6153 c 1 = SC...Ca...Ca...Ca
6154 c 2 = Ca...Ca...Ca...SC
6155 c 3 = SC...Ca...Ca...SCi
6157 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6158 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6159 & (itype(i-1).eq.ntyp1)))
6160 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6161 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6162 & .or.(itype(i).eq.ntyp1)))
6163 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6164 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6165 & (itype(i-3).eq.ntyp1)))) cycle
6166 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6167 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6169 do j=1,nterm_sccor(isccori,isccori1)
6170 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6171 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6172 cosphi=dcos(j*tauangle(intertyp,i))
6173 sinphi=dsin(j*tauangle(intertyp,i))
6174 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6175 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6177 C write (iout,*)"EBACK_SC_COR",esccor,i
6178 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6179 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6180 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6182 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6183 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6184 & (v1sccor(j,1,itori,itori1),j=1,6)
6185 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6186 c gsccor_loc(i-3)=gloci
6192 c------------------------------------------------------------------------------
6193 subroutine multibody(ecorr)
6194 C This subroutine calculates multi-body contributions to energy following
6195 C the idea of Skolnick et al. If side chains I and J make a contact and
6196 C at the same time side chains I+1 and J+1 make a contact, an extra
6197 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6198 implicit real*8 (a-h,o-z)
6199 include 'DIMENSIONS'
6200 include 'COMMON.IOUNITS'
6201 include 'COMMON.DERIV'
6202 include 'COMMON.INTERACT'
6203 include 'COMMON.CONTACTS'
6204 include 'COMMON.CONTMAT'
6205 include 'COMMON.CORRMAT'
6206 double precision gx(3),gx1(3)
6209 C Set lprn=.true. for debugging
6213 write (iout,'(a)') 'Contact function values:'
6215 write (iout,'(i2,20(1x,i2,f10.5))')
6216 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6231 num_conti=num_cont(i)
6232 num_conti1=num_cont(i1)
6237 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6238 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6239 cd & ' ishift=',ishift
6240 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6241 C The system gains extra energy.
6242 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6243 endif ! j1==j+-ishift
6252 c------------------------------------------------------------------------------
6253 double precision function esccorr(i,j,k,l,jj,kk)
6254 implicit real*8 (a-h,o-z)
6255 include 'DIMENSIONS'
6256 include 'COMMON.IOUNITS'
6257 include 'COMMON.DERIV'
6258 include 'COMMON.INTERACT'
6259 include 'COMMON.CONTACTS'
6260 include 'COMMON.CONTMAT'
6261 include 'COMMON.CORRMAT'
6262 double precision gx(3),gx1(3)
6267 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6268 C Calculate the multi-body contribution to energy.
6269 C Calculate multi-body contributions to the gradient.
6270 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6271 cd & k,l,(gacont(m,kk,k),m=1,3)
6273 gx(m) =ekl*gacont(m,jj,i)
6274 gx1(m)=eij*gacont(m,kk,k)
6275 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6276 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6277 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6278 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6282 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6287 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6293 c------------------------------------------------------------------------------
6294 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6295 C This subroutine calculates multi-body contributions to hydrogen-bonding
6296 implicit real*8 (a-h,o-z)
6297 include 'DIMENSIONS'
6298 include 'COMMON.IOUNITS'
6299 include 'COMMON.FFIELD'
6300 include 'COMMON.DERIV'
6301 include 'COMMON.INTERACT'
6302 include 'COMMON.CONTACTS'
6303 include 'COMMON.CONTMAT'
6304 include 'COMMON.CORRMAT'
6305 double precision gx(3),gx1(3)
6308 C Set lprn=.true. for debugging
6311 write (iout,'(a)') 'Contact function values:'
6313 write (iout,'(2i3,50(1x,i2,f5.2))')
6314 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6315 & j=1,num_cont_hb(i))
6319 C Remove the loop below after debugging !!!
6326 C Calculate the local-electrostatic correlation terms
6327 do i=iatel_s,iatel_e+1
6329 num_conti=num_cont_hb(i)
6330 num_conti1=num_cont_hb(i+1)
6335 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6336 c & ' jj=',jj,' kk=',kk
6337 if (j1.eq.j+1 .or. j1.eq.j-1) then
6338 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6339 C The system gains extra energy.
6340 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6342 else if (j1.eq.j) then
6343 C Contacts I-J and I-(J+1) occur simultaneously.
6344 C The system loses extra energy.
6345 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6350 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6351 c & ' jj=',jj,' kk=',kk
6353 C Contacts I-J and (I+1)-J occur simultaneously.
6354 C The system loses extra energy.
6355 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6362 c------------------------------------------------------------------------------
6363 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6365 C This subroutine calculates multi-body contributions to hydrogen-bonding
6366 implicit real*8 (a-h,o-z)
6367 include 'DIMENSIONS'
6368 include 'COMMON.IOUNITS'
6372 include 'COMMON.FFIELD'
6373 include 'COMMON.DERIV'
6374 include 'COMMON.LOCAL'
6375 include 'COMMON.INTERACT'
6376 include 'COMMON.CONTACTS'
6377 include 'COMMON.CONTMAT'
6378 include 'COMMON.CORRMAT'
6379 include 'COMMON.CHAIN'
6380 include 'COMMON.CONTROL'
6381 include 'COMMON.SHIELD'
6382 double precision gx(3),gx1(3)
6383 integer num_cont_hb_old(maxres)
6385 double precision eello4,eello5,eelo6,eello_turn6
6386 external eello4,eello5,eello6,eello_turn6
6387 C Set lprn=.true. for debugging
6391 write (iout,'(a)') 'Contact function values:'
6393 write (iout,'(2i3,50(1x,i2,5f6.3))')
6394 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6395 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6401 C Remove the loop below after debugging !!!
6408 C Calculate the dipole-dipole interaction energies
6409 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6410 do i=iatel_s,iatel_e+1
6411 num_conti=num_cont_hb(i)
6420 C Calculate the local-electrostatic correlation terms
6421 c write (iout,*) "gradcorr5 in eello5 before loop"
6423 c write (iout,'(i5,3f10.5)')
6424 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6426 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6427 c write (iout,*) "corr loop i",i
6429 num_conti=num_cont_hb(i)
6430 num_conti1=num_cont_hb(i+1)
6437 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6438 c & ' jj=',jj,' kk=',kk
6439 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6440 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6441 & .or. j.lt.0 .and. j1.gt.0) .and.
6442 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6443 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6444 C The system gains extra energy.
6446 sqd1=dsqrt(d_cont(jj,i))
6447 sqd2=dsqrt(d_cont(kk,i1))
6448 sred_geom = sqd1*sqd2
6449 IF (sred_geom.lt.cutoff_corr) THEN
6450 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6452 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6453 cd & ' jj=',jj,' kk=',kk
6454 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6455 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6457 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6458 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6461 cd write (iout,*) 'sred_geom=',sred_geom,
6462 cd & ' ekont=',ekont,' fprim=',fprimcont,
6463 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6464 cd write (iout,*) "g_contij",g_contij
6465 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6466 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6467 call calc_eello(i,jp,i+1,jp1,jj,kk)
6468 if (wcorr4.gt.0.0d0)
6469 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6470 CC & *fac_shield(i)**2*fac_shield(j)**2
6471 if (energy_dec.and.wcorr4.gt.0.0d0)
6472 1 write (iout,'(a6,4i5,0pf7.3)')
6473 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6474 c write (iout,*) "gradcorr5 before eello5"
6476 c write (iout,'(i5,3f10.5)')
6477 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6479 if (wcorr5.gt.0.0d0)
6480 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6481 c write (iout,*) "gradcorr5 after eello5"
6483 c write (iout,'(i5,3f10.5)')
6484 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6486 if (energy_dec.and.wcorr5.gt.0.0d0)
6487 1 write (iout,'(a6,4i5,0pf7.3)')
6488 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6489 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6490 cd write(2,*)'ijkl',i,jp,i+1,jp1
6491 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6492 & .or. wturn6.eq.0.0d0))then
6493 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6494 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6495 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6496 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6497 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6498 cd & 'ecorr6=',ecorr6
6499 cd write (iout,'(4e15.5)') sred_geom,
6500 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6501 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6502 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6503 else if (wturn6.gt.0.0d0
6504 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6505 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6506 eturn6=eturn6+eello_turn6(i,jj,kk)
6507 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6508 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6509 cd write (2,*) 'multibody_eello:eturn6',eturn6
6518 num_cont_hb(i)=num_cont_hb_old(i)
6520 c write (iout,*) "gradcorr5 in eello5"
6522 c write (iout,'(i5,3f10.5)')
6523 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6527 c------------------------------------------------------------------------------
6528 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6529 implicit real*8 (a-h,o-z)
6530 include 'DIMENSIONS'
6531 include 'COMMON.IOUNITS'
6532 include 'COMMON.DERIV'
6533 include 'COMMON.INTERACT'
6534 include 'COMMON.CONTACTS'
6535 include 'COMMON.CONTMAT'
6536 include 'COMMON.CORRMAT'
6537 include 'COMMON.SHIELD'
6538 include 'COMMON.CONTROL'
6539 double precision gx(3),gx1(3)
6542 C print *,"wchodze",fac_shield(i),shield_mode
6550 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6552 C & fac_shield(i)**2*fac_shield(j)**2
6553 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6554 C Following 4 lines for diagnostics.
6559 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6560 c & 'Contacts ',i,j,
6561 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6562 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6564 C Calculate the multi-body contribution to energy.
6565 C ecorr=ecorr+ekont*ees
6566 C Calculate multi-body contributions to the gradient.
6567 coeffpees0pij=coeffp*ees0pij
6568 coeffmees0mij=coeffm*ees0mij
6569 coeffpees0pkl=coeffp*ees0pkl
6570 coeffmees0mkl=coeffm*ees0mkl
6572 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6573 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6574 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6575 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6576 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6577 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6578 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6579 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6580 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6581 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6582 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6583 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6584 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6585 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6586 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6587 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6588 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6589 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6590 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6591 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6592 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6593 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6594 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6595 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6596 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6601 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6602 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6603 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6604 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6609 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6610 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6611 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6612 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6615 c write (iout,*) "ehbcorr",ekont*ees
6616 C print *,ekont,ees,i,k
6618 C now gradient over shielding
6620 if (shield_mode.gt.0) then
6623 C print *,i,j,fac_shield(i),fac_shield(j),
6624 C &fac_shield(k),fac_shield(l)
6625 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6626 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6627 do ilist=1,ishield_list(i)
6628 iresshield=shield_list(ilist,i)
6630 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6632 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6634 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6635 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6639 do ilist=1,ishield_list(j)
6640 iresshield=shield_list(ilist,j)
6642 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6644 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6646 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6647 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6652 do ilist=1,ishield_list(k)
6653 iresshield=shield_list(ilist,k)
6655 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6657 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6659 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6660 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6664 do ilist=1,ishield_list(l)
6665 iresshield=shield_list(ilist,l)
6667 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6669 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6671 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6672 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6676 C print *,gshieldx(m,iresshield)
6678 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6679 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6680 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6681 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6682 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6683 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6684 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6685 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6687 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6688 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6689 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6690 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6691 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6692 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6693 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6694 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6702 C---------------------------------------------------------------------------
6703 subroutine dipole(i,j,jj)
6704 implicit real*8 (a-h,o-z)
6705 include 'DIMENSIONS'
6706 include 'COMMON.IOUNITS'
6707 include 'COMMON.CHAIN'
6708 include 'COMMON.FFIELD'
6709 include 'COMMON.DERIV'
6710 include 'COMMON.INTERACT'
6711 include 'COMMON.CONTACTS'
6712 include 'COMMON.CONTMAT'
6713 include 'COMMON.CORRMAT'
6714 include 'COMMON.TORSION'
6715 include 'COMMON.VAR'
6716 include 'COMMON.GEO'
6717 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6719 iti1 = itortyp(itype(i+1))
6720 if (j.lt.nres-1) then
6721 itj1 = itype2loc(itype(j+1))
6726 dipi(iii,1)=Ub2(iii,i)
6727 dipderi(iii)=Ub2der(iii,i)
6728 dipi(iii,2)=b1(iii,i+1)
6729 dipj(iii,1)=Ub2(iii,j)
6730 dipderj(iii)=Ub2der(iii,j)
6731 dipj(iii,2)=b1(iii,j+1)
6735 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6738 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6745 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6749 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6754 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6755 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6757 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6759 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6761 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6766 C---------------------------------------------------------------------------
6767 subroutine calc_eello(i,j,k,l,jj,kk)
6769 C This subroutine computes matrices and vectors needed to calculate
6770 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6772 implicit real*8 (a-h,o-z)
6773 include 'DIMENSIONS'
6774 include 'COMMON.IOUNITS'
6775 include 'COMMON.CHAIN'
6776 include 'COMMON.DERIV'
6777 include 'COMMON.INTERACT'
6778 include 'COMMON.CONTACTS'
6779 include 'COMMON.CONTMAT'
6780 include 'COMMON.CORRMAT'
6781 include 'COMMON.TORSION'
6782 include 'COMMON.VAR'
6783 include 'COMMON.GEO'
6784 include 'COMMON.FFIELD'
6785 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6786 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6789 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6790 cd & ' jj=',jj,' kk=',kk
6791 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6792 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6793 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6796 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6797 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6800 call transpose2(aa1(1,1),aa1t(1,1))
6801 call transpose2(aa2(1,1),aa2t(1,1))
6804 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6805 & aa1tder(1,1,lll,kkk))
6806 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6807 & aa2tder(1,1,lll,kkk))
6811 C parallel orientation of the two CA-CA-CA frames.
6813 iti=itype2loc(itype(i))
6817 itk1=itype2loc(itype(k+1))
6818 itj=itype2loc(itype(j))
6819 if (l.lt.nres-1) then
6820 itl1=itype2loc(itype(l+1))
6824 C A1 kernel(j+1) A2T
6826 cd write (iout,'(3f10.5,5x,3f10.5)')
6827 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6829 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6830 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6831 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6832 C Following matrices are needed only for 6-th order cumulants
6833 IF (wcorr6.gt.0.0d0) THEN
6834 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6835 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6836 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6837 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6838 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6839 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6840 & ADtEAderx(1,1,1,1,1,1))
6842 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6843 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6844 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6845 & ADtEA1derx(1,1,1,1,1,1))
6847 C End 6-th order cumulants
6850 cd write (2,*) 'In calc_eello6'
6852 cd write (2,*) 'iii=',iii
6854 cd write (2,*) 'kkk=',kkk
6856 cd write (2,'(3(2f10.5),5x)')
6857 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6862 call transpose2(EUgder(1,1,k),auxmat(1,1))
6863 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6864 call transpose2(EUg(1,1,k),auxmat(1,1))
6865 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6866 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6870 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6871 & EAEAderx(1,1,lll,kkk,iii,1))
6875 C A1T kernel(i+1) A2
6876 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6877 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6878 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6879 C Following matrices are needed only for 6-th order cumulants
6880 IF (wcorr6.gt.0.0d0) THEN
6881 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6882 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6883 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6884 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6885 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6886 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6887 & ADtEAderx(1,1,1,1,1,2))
6888 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6889 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6890 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6891 & ADtEA1derx(1,1,1,1,1,2))
6893 C End 6-th order cumulants
6894 call transpose2(EUgder(1,1,l),auxmat(1,1))
6895 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6896 call transpose2(EUg(1,1,l),auxmat(1,1))
6897 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6898 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6902 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6903 & EAEAderx(1,1,lll,kkk,iii,2))
6908 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6909 C They are needed only when the fifth- or the sixth-order cumulants are
6911 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6912 call transpose2(AEA(1,1,1),auxmat(1,1))
6913 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
6914 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6915 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6916 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6917 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
6918 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6919 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
6920 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
6921 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6922 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6923 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6924 call transpose2(AEA(1,1,2),auxmat(1,1))
6925 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
6926 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6927 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6928 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6929 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
6930 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6931 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
6932 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
6933 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6934 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6935 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6936 C Calculate the Cartesian derivatives of the vectors.
6940 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6941 call matvec2(auxmat(1,1),b1(1,i),
6942 & AEAb1derx(1,lll,kkk,iii,1,1))
6943 call matvec2(auxmat(1,1),Ub2(1,i),
6944 & AEAb2derx(1,lll,kkk,iii,1,1))
6945 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
6946 & AEAb1derx(1,lll,kkk,iii,2,1))
6947 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6948 & AEAb2derx(1,lll,kkk,iii,2,1))
6949 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6950 call matvec2(auxmat(1,1),b1(1,j),
6951 & AEAb1derx(1,lll,kkk,iii,1,2))
6952 call matvec2(auxmat(1,1),Ub2(1,j),
6953 & AEAb2derx(1,lll,kkk,iii,1,2))
6954 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
6955 & AEAb1derx(1,lll,kkk,iii,2,2))
6956 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6957 & AEAb2derx(1,lll,kkk,iii,2,2))
6964 C Antiparallel orientation of the two CA-CA-CA frames.
6966 iti=itype2loc(itype(i))
6970 itk1=itype2loc(itype(k+1))
6971 itl=itype2loc(itype(l))
6972 itj=itype2loc(itype(j))
6973 if (j.lt.nres-1) then
6974 itj1=itype2loc(itype(j+1))
6978 C A2 kernel(j-1)T A1T
6979 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6980 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6981 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6982 C Following matrices are needed only for 6-th order cumulants
6983 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6984 & j.eq.i+4 .and. l.eq.i+3)) THEN
6985 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6986 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6987 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6988 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6989 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6990 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6991 & ADtEAderx(1,1,1,1,1,1))
6992 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6993 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6994 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6995 & ADtEA1derx(1,1,1,1,1,1))
6997 C End 6-th order cumulants
6998 call transpose2(EUgder(1,1,k),auxmat(1,1))
6999 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7000 call transpose2(EUg(1,1,k),auxmat(1,1))
7001 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7002 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7006 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7007 & EAEAderx(1,1,lll,kkk,iii,1))
7011 C A2T kernel(i+1)T A1
7012 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7013 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7014 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7015 C Following matrices are needed only for 6-th order cumulants
7016 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7017 & j.eq.i+4 .and. l.eq.i+3)) THEN
7018 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7019 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7020 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7021 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7022 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7023 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7024 & ADtEAderx(1,1,1,1,1,2))
7025 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7026 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7027 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7028 & ADtEA1derx(1,1,1,1,1,2))
7030 C End 6-th order cumulants
7031 call transpose2(EUgder(1,1,j),auxmat(1,1))
7032 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7033 call transpose2(EUg(1,1,j),auxmat(1,1))
7034 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7035 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7039 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7040 & EAEAderx(1,1,lll,kkk,iii,2))
7045 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7046 C They are needed only when the fifth- or the sixth-order cumulants are
7048 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7049 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7050 call transpose2(AEA(1,1,1),auxmat(1,1))
7051 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7052 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7053 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7054 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7055 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7056 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7057 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7058 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7059 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7060 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7061 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7062 call transpose2(AEA(1,1,2),auxmat(1,1))
7063 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7064 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7065 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7066 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7067 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7068 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7069 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7070 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7071 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7072 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7073 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7074 C Calculate the Cartesian derivatives of the vectors.
7078 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7079 call matvec2(auxmat(1,1),b1(1,i),
7080 & AEAb1derx(1,lll,kkk,iii,1,1))
7081 call matvec2(auxmat(1,1),Ub2(1,i),
7082 & AEAb2derx(1,lll,kkk,iii,1,1))
7083 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7084 & AEAb1derx(1,lll,kkk,iii,2,1))
7085 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7086 & AEAb2derx(1,lll,kkk,iii,2,1))
7087 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7088 call matvec2(auxmat(1,1),b1(1,l),
7089 & AEAb1derx(1,lll,kkk,iii,1,2))
7090 call matvec2(auxmat(1,1),Ub2(1,l),
7091 & AEAb2derx(1,lll,kkk,iii,1,2))
7092 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7093 & AEAb1derx(1,lll,kkk,iii,2,2))
7094 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7095 & AEAb2derx(1,lll,kkk,iii,2,2))
7104 C---------------------------------------------------------------------------
7105 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7106 & KK,KKderg,AKA,AKAderg,AKAderx)
7110 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7111 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7112 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7117 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7119 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7122 cd if (lprn) write (2,*) 'In kernel'
7124 cd if (lprn) write (2,*) 'kkk=',kkk
7126 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7127 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7129 cd write (2,*) 'lll=',lll
7130 cd write (2,*) 'iii=1'
7132 cd write (2,'(3(2f10.5),5x)')
7133 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7136 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7137 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7139 cd write (2,*) 'lll=',lll
7140 cd write (2,*) 'iii=2'
7142 cd write (2,'(3(2f10.5),5x)')
7143 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7150 C---------------------------------------------------------------------------
7151 double precision function eello4(i,j,k,l,jj,kk)
7152 implicit real*8 (a-h,o-z)
7153 include 'DIMENSIONS'
7154 include 'COMMON.IOUNITS'
7155 include 'COMMON.CHAIN'
7156 include 'COMMON.DERIV'
7157 include 'COMMON.INTERACT'
7158 include 'COMMON.CONTACTS'
7159 include 'COMMON.CONTMAT'
7160 include 'COMMON.CORRMAT'
7161 include 'COMMON.TORSION'
7162 include 'COMMON.VAR'
7163 include 'COMMON.GEO'
7164 double precision pizda(2,2),ggg1(3),ggg2(3)
7165 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7169 cd print *,'eello4:',i,j,k,l,jj,kk
7170 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7171 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7172 cold eij=facont_hb(jj,i)
7173 cold ekl=facont_hb(kk,k)
7175 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7177 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7178 gcorr_loc(k-1)=gcorr_loc(k-1)
7179 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7181 gcorr_loc(l-1)=gcorr_loc(l-1)
7182 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7184 gcorr_loc(j-1)=gcorr_loc(j-1)
7185 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7190 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7191 & -EAEAderx(2,2,lll,kkk,iii,1)
7192 cd derx(lll,kkk,iii)=0.0d0
7196 cd gcorr_loc(l-1)=0.0d0
7197 cd gcorr_loc(j-1)=0.0d0
7198 cd gcorr_loc(k-1)=0.0d0
7200 cd write (iout,*)'Contacts have occurred for peptide groups',
7201 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7202 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7203 if (j.lt.nres-1) then
7210 if (l.lt.nres-1) then
7218 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7219 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7220 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7221 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7222 cgrad ghalf=0.5d0*ggg1(ll)
7223 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7224 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7225 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7226 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7227 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7228 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7229 cgrad ghalf=0.5d0*ggg2(ll)
7230 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7231 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7232 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7233 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7234 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7235 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7239 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7244 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7249 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7254 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7258 cd write (2,*) iii,gcorr_loc(iii)
7262 cd write (2,*) 'ekont',ekont
7263 cd write (iout,*) 'eello4',ekont*eel4
7266 C---------------------------------------------------------------------------
7267 double precision function eello5(i,j,k,l,jj,kk)
7268 implicit real*8 (a-h,o-z)
7269 include 'DIMENSIONS'
7270 include 'COMMON.IOUNITS'
7271 include 'COMMON.CHAIN'
7272 include 'COMMON.DERIV'
7273 include 'COMMON.INTERACT'
7274 include 'COMMON.CONTACTS'
7275 include 'COMMON.CONTMAT'
7276 include 'COMMON.CORRMAT'
7277 include 'COMMON.TORSION'
7278 include 'COMMON.VAR'
7279 include 'COMMON.GEO'
7280 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7281 double precision ggg1(3),ggg2(3)
7282 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7287 C /l\ / \ \ / \ / \ / C
7288 C / \ / \ \ / \ / \ / C
7289 C j| o |l1 | o | o| o | | o |o C
7290 C \ |/k\| |/ \| / |/ \| |/ \| C
7291 C \i/ \ / \ / / \ / \ C
7293 C (I) (II) (III) (IV) C
7295 C eello5_1 eello5_2 eello5_3 eello5_4 C
7297 C Antiparallel chains C
7300 C /j\ / \ \ / \ / \ / C
7301 C / \ / \ \ / \ / \ / C
7302 C j1| o |l | o | o| o | | o |o C
7303 C \ |/k\| |/ \| / |/ \| |/ \| C
7304 C \i/ \ / \ / / \ / \ C
7306 C (I) (II) (III) (IV) C
7308 C eello5_1 eello5_2 eello5_3 eello5_4 C
7310 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7312 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7313 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7318 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7320 itk=itype2loc(itype(k))
7321 itl=itype2loc(itype(l))
7322 itj=itype2loc(itype(j))
7327 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7328 cd & eel5_3_num,eel5_4_num)
7332 derx(lll,kkk,iii)=0.0d0
7336 cd eij=facont_hb(jj,i)
7337 cd ekl=facont_hb(kk,k)
7339 cd write (iout,*)'Contacts have occurred for peptide groups',
7340 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7342 C Contribution from the graph I.
7343 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7344 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7345 call transpose2(EUg(1,1,k),auxmat(1,1))
7346 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7347 vv(1)=pizda(1,1)-pizda(2,2)
7348 vv(2)=pizda(1,2)+pizda(2,1)
7349 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7350 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7352 C Explicit gradient in virtual-dihedral angles.
7353 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7354 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7355 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7356 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7357 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7358 vv(1)=pizda(1,1)-pizda(2,2)
7359 vv(2)=pizda(1,2)+pizda(2,1)
7360 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7361 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7362 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7363 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7364 vv(1)=pizda(1,1)-pizda(2,2)
7365 vv(2)=pizda(1,2)+pizda(2,1)
7367 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7368 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7369 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7371 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7372 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7373 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7375 C Cartesian gradient
7379 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7381 vv(1)=pizda(1,1)-pizda(2,2)
7382 vv(2)=pizda(1,2)+pizda(2,1)
7383 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7384 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7385 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7392 C Contribution from graph II
7393 call transpose2(EE(1,1,k),auxmat(1,1))
7394 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7395 vv(1)=pizda(1,1)+pizda(2,2)
7396 vv(2)=pizda(2,1)-pizda(1,2)
7397 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7398 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7400 C Explicit gradient in virtual-dihedral angles.
7401 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7402 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7403 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7404 vv(1)=pizda(1,1)+pizda(2,2)
7405 vv(2)=pizda(2,1)-pizda(1,2)
7407 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7408 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7409 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7411 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7412 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7413 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7415 C Cartesian gradient
7419 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7421 vv(1)=pizda(1,1)+pizda(2,2)
7422 vv(2)=pizda(2,1)-pizda(1,2)
7423 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7424 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7425 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7434 C Parallel orientation
7435 C Contribution from graph III
7436 call transpose2(EUg(1,1,l),auxmat(1,1))
7437 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7438 vv(1)=pizda(1,1)-pizda(2,2)
7439 vv(2)=pizda(1,2)+pizda(2,1)
7440 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7441 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7443 C Explicit gradient in virtual-dihedral angles.
7444 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7445 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7446 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7447 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7448 vv(1)=pizda(1,1)-pizda(2,2)
7449 vv(2)=pizda(1,2)+pizda(2,1)
7450 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7451 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7452 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7453 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7454 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7455 vv(1)=pizda(1,1)-pizda(2,2)
7456 vv(2)=pizda(1,2)+pizda(2,1)
7457 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7458 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7459 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7460 C Cartesian gradient
7464 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7466 vv(1)=pizda(1,1)-pizda(2,2)
7467 vv(2)=pizda(1,2)+pizda(2,1)
7468 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7469 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7470 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7475 C Contribution from graph IV
7477 call transpose2(EE(1,1,l),auxmat(1,1))
7478 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7479 vv(1)=pizda(1,1)+pizda(2,2)
7480 vv(2)=pizda(2,1)-pizda(1,2)
7481 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7482 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7483 C Explicit gradient in virtual-dihedral angles.
7484 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7485 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7486 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7487 vv(1)=pizda(1,1)+pizda(2,2)
7488 vv(2)=pizda(2,1)-pizda(1,2)
7489 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7490 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7491 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7492 C Cartesian gradient
7496 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7498 vv(1)=pizda(1,1)+pizda(2,2)
7499 vv(2)=pizda(2,1)-pizda(1,2)
7500 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7501 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7502 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7508 C Antiparallel orientation
7509 C Contribution from graph III
7511 call transpose2(EUg(1,1,j),auxmat(1,1))
7512 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7513 vv(1)=pizda(1,1)-pizda(2,2)
7514 vv(2)=pizda(1,2)+pizda(2,1)
7515 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7516 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7518 C Explicit gradient in virtual-dihedral angles.
7519 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7520 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7521 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7522 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7523 vv(1)=pizda(1,1)-pizda(2,2)
7524 vv(2)=pizda(1,2)+pizda(2,1)
7525 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7526 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7527 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7528 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7529 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7530 vv(1)=pizda(1,1)-pizda(2,2)
7531 vv(2)=pizda(1,2)+pizda(2,1)
7532 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7533 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7534 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7535 C Cartesian gradient
7539 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7541 vv(1)=pizda(1,1)-pizda(2,2)
7542 vv(2)=pizda(1,2)+pizda(2,1)
7543 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7544 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7545 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7551 C Contribution from graph IV
7553 call transpose2(EE(1,1,j),auxmat(1,1))
7554 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7555 vv(1)=pizda(1,1)+pizda(2,2)
7556 vv(2)=pizda(2,1)-pizda(1,2)
7557 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7558 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7560 C Explicit gradient in virtual-dihedral angles.
7561 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7562 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7563 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7564 vv(1)=pizda(1,1)+pizda(2,2)
7565 vv(2)=pizda(2,1)-pizda(1,2)
7566 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7567 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7568 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7569 C Cartesian gradient
7573 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7575 vv(1)=pizda(1,1)+pizda(2,2)
7576 vv(2)=pizda(2,1)-pizda(1,2)
7577 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7578 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7579 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7586 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7587 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7588 cd write (2,*) 'ijkl',i,j,k,l
7589 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7590 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7592 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7593 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7594 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7595 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7597 if (j.lt.nres-1) then
7604 if (l.lt.nres-1) then
7614 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7615 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7616 C summed up outside the subrouine as for the other subroutines
7617 C handling long-range interactions. The old code is commented out
7618 C with "cgrad" to keep track of changes.
7620 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7621 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7622 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7623 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7624 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7625 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7626 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7627 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7628 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7629 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7631 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7632 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7633 cgrad ghalf=0.5d0*ggg1(ll)
7635 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7636 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7637 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7638 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7639 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7640 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7641 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7642 cgrad ghalf=0.5d0*ggg2(ll)
7644 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7645 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7646 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7647 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7648 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7649 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7655 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7656 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7661 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7662 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7668 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7673 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7677 cd write (2,*) iii,g_corr5_loc(iii)
7680 cd write (2,*) 'ekont',ekont
7681 cd write (iout,*) 'eello5',ekont*eel5
7684 c--------------------------------------------------------------------------
7685 double precision function eello6(i,j,k,l,jj,kk)
7686 implicit real*8 (a-h,o-z)
7687 include 'DIMENSIONS'
7688 include 'COMMON.IOUNITS'
7689 include 'COMMON.CHAIN'
7690 include 'COMMON.DERIV'
7691 include 'COMMON.INTERACT'
7692 include 'COMMON.CONTACTS'
7693 include 'COMMON.CONTMAT'
7694 include 'COMMON.CORRMAT'
7695 include 'COMMON.TORSION'
7696 include 'COMMON.VAR'
7697 include 'COMMON.GEO'
7698 include 'COMMON.FFIELD'
7699 double precision ggg1(3),ggg2(3)
7700 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7705 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7713 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7714 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7718 derx(lll,kkk,iii)=0.0d0
7722 cd eij=facont_hb(jj,i)
7723 cd ekl=facont_hb(kk,k)
7729 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7730 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7731 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7732 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7733 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7734 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7736 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7737 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7738 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7739 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7740 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7741 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7745 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7747 C If turn contributions are considered, they will be handled separately.
7748 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7749 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7750 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7751 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7752 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7753 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7754 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7757 if (j.lt.nres-1) then
7764 if (l.lt.nres-1) then
7772 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7773 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7774 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7775 cgrad ghalf=0.5d0*ggg1(ll)
7777 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7778 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7779 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7780 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7781 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7782 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7783 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7784 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7785 cgrad ghalf=0.5d0*ggg2(ll)
7786 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7788 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7789 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7790 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7791 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7792 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7793 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7799 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7800 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7805 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7806 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7812 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7817 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7821 cd write (2,*) iii,g_corr6_loc(iii)
7824 cd write (2,*) 'ekont',ekont
7825 cd write (iout,*) 'eello6',ekont*eel6
7828 c--------------------------------------------------------------------------
7829 double precision function eello6_graph1(i,j,k,l,imat,swap)
7830 implicit real*8 (a-h,o-z)
7831 include 'DIMENSIONS'
7832 include 'COMMON.IOUNITS'
7833 include 'COMMON.CHAIN'
7834 include 'COMMON.DERIV'
7835 include 'COMMON.INTERACT'
7836 include 'COMMON.CONTACTS'
7837 include 'COMMON.CONTMAT'
7838 include 'COMMON.CORRMAT'
7839 include 'COMMON.TORSION'
7840 include 'COMMON.VAR'
7841 include 'COMMON.GEO'
7842 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7846 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7848 C Parallel Antiparallel C
7854 C \ j|/k\| / \ |/k\|l / C
7859 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7860 itk=itype2loc(itype(k))
7861 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7862 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7863 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7864 call transpose2(EUgC(1,1,k),auxmat(1,1))
7865 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7866 vv1(1)=pizda1(1,1)-pizda1(2,2)
7867 vv1(2)=pizda1(1,2)+pizda1(2,1)
7868 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7869 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
7870 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
7871 s5=scalar2(vv(1),Dtobr2(1,i))
7872 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7873 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7875 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7876 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7877 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7878 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7879 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7880 & +scalar2(vv(1),Dtobr2der(1,i)))
7881 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7882 vv1(1)=pizda1(1,1)-pizda1(2,2)
7883 vv1(2)=pizda1(1,2)+pizda1(2,1)
7884 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
7885 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
7887 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7888 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7889 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7890 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7891 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7893 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7894 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7895 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7896 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7897 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7899 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7900 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7901 vv1(1)=pizda1(1,1)-pizda1(2,2)
7902 vv1(2)=pizda1(1,2)+pizda1(2,1)
7903 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7904 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7905 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7906 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7915 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7916 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7917 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7918 call transpose2(EUgC(1,1,k),auxmat(1,1))
7919 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7921 vv1(1)=pizda1(1,1)-pizda1(2,2)
7922 vv1(2)=pizda1(1,2)+pizda1(2,1)
7923 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7924 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
7925 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
7926 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
7927 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
7928 s5=scalar2(vv(1),Dtobr2(1,i))
7929 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7936 c----------------------------------------------------------------------------
7937 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7938 implicit real*8 (a-h,o-z)
7939 include 'DIMENSIONS'
7940 include 'COMMON.IOUNITS'
7941 include 'COMMON.CHAIN'
7942 include 'COMMON.DERIV'
7943 include 'COMMON.INTERACT'
7944 include 'COMMON.CONTACTS'
7945 include 'COMMON.CONTMAT'
7946 include 'COMMON.CORRMAT'
7947 include 'COMMON.TORSION'
7948 include 'COMMON.VAR'
7949 include 'COMMON.GEO'
7951 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7952 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7955 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7957 C Parallel Antiparallel C
7963 C \ j|/k\| \ |/k\|l C
7968 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7969 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7970 C AL 7/4/01 s1 would occur in the sixth-order moment,
7971 C but not in a cluster cumulant
7973 s1=dip(1,jj,i)*dip(1,kk,k)
7975 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7976 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7977 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7978 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7979 call transpose2(EUg(1,1,k),auxmat(1,1))
7980 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7981 vv(1)=pizda(1,1)-pizda(2,2)
7982 vv(2)=pizda(1,2)+pizda(2,1)
7983 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7984 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7986 eello6_graph2=-(s1+s2+s3+s4)
7988 eello6_graph2=-(s2+s3+s4)
7991 C Derivatives in gamma(i-1)
7995 s1=dipderg(1,jj,i)*dip(1,kk,k)
7997 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7998 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7999 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8000 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8002 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8004 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8006 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8008 C Derivatives in gamma(k-1)
8010 s1=dip(1,jj,i)*dipderg(1,kk,k)
8012 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8013 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8014 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8015 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8016 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8017 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8018 vv(1)=pizda(1,1)-pizda(2,2)
8019 vv(2)=pizda(1,2)+pizda(2,1)
8020 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8022 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8024 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8026 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8027 C Derivatives in gamma(j-1) or gamma(l-1)
8030 s1=dipderg(3,jj,i)*dip(1,kk,k)
8032 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8033 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8034 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8035 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8036 vv(1)=pizda(1,1)-pizda(2,2)
8037 vv(2)=pizda(1,2)+pizda(2,1)
8038 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8041 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8043 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8046 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8047 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8049 C Derivatives in gamma(l-1) or gamma(j-1)
8052 s1=dip(1,jj,i)*dipderg(3,kk,k)
8054 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8055 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8056 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8057 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8058 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8059 vv(1)=pizda(1,1)-pizda(2,2)
8060 vv(2)=pizda(1,2)+pizda(2,1)
8061 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8064 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8066 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8069 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8070 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8072 C Cartesian derivatives.
8074 write (2,*) 'In eello6_graph2'
8076 write (2,*) 'iii=',iii
8078 write (2,*) 'kkk=',kkk
8080 write (2,'(3(2f10.5),5x)')
8081 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8091 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8093 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8096 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8098 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8099 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8101 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8102 call transpose2(EUg(1,1,k),auxmat(1,1))
8103 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8105 vv(1)=pizda(1,1)-pizda(2,2)
8106 vv(2)=pizda(1,2)+pizda(2,1)
8107 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8108 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8110 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8112 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8115 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8117 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8125 c----------------------------------------------------------------------------
8126 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8127 implicit real*8 (a-h,o-z)
8128 include 'DIMENSIONS'
8129 include 'COMMON.IOUNITS'
8130 include 'COMMON.CHAIN'
8131 include 'COMMON.DERIV'
8132 include 'COMMON.INTERACT'
8133 include 'COMMON.CONTACTS'
8134 include 'COMMON.CONTMAT'
8135 include 'COMMON.CORRMAT'
8136 include 'COMMON.TORSION'
8137 include 'COMMON.VAR'
8138 include 'COMMON.GEO'
8139 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8141 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8143 C Parallel Antiparallel C
8149 C j|/k\| / |/k\|l / C
8154 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8156 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8157 C energy moment and not to the cluster cumulant.
8158 iti=itortyp(itype(i))
8159 if (j.lt.nres-1) then
8160 itj1=itype2loc(itype(j+1))
8164 itk=itype2loc(itype(k))
8165 itk1=itype2loc(itype(k+1))
8166 if (l.lt.nres-1) then
8167 itl1=itype2loc(itype(l+1))
8172 s1=dip(4,jj,i)*dip(4,kk,k)
8174 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8175 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8176 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8177 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8178 call transpose2(EE(1,1,k),auxmat(1,1))
8179 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8180 vv(1)=pizda(1,1)+pizda(2,2)
8181 vv(2)=pizda(2,1)-pizda(1,2)
8182 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8183 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8184 cd & "sum",-(s2+s3+s4)
8186 eello6_graph3=-(s1+s2+s3+s4)
8188 eello6_graph3=-(s2+s3+s4)
8191 C Derivatives in gamma(k-1)
8193 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8194 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8195 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8196 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8197 C Derivatives in gamma(l-1)
8198 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8199 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8200 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8201 vv(1)=pizda(1,1)+pizda(2,2)
8202 vv(2)=pizda(2,1)-pizda(1,2)
8203 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8204 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8205 C Cartesian derivatives.
8211 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8213 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8216 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8218 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8219 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8221 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8222 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8224 vv(1)=pizda(1,1)+pizda(2,2)
8225 vv(2)=pizda(2,1)-pizda(1,2)
8226 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8228 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8230 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8233 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8235 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8237 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8244 c----------------------------------------------------------------------------
8245 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8246 implicit real*8 (a-h,o-z)
8247 include 'DIMENSIONS'
8248 include 'COMMON.IOUNITS'
8249 include 'COMMON.CHAIN'
8250 include 'COMMON.DERIV'
8251 include 'COMMON.INTERACT'
8252 include 'COMMON.CONTACTS'
8253 include 'COMMON.CONTMAT'
8254 include 'COMMON.CORRMAT'
8255 include 'COMMON.TORSION'
8256 include 'COMMON.VAR'
8257 include 'COMMON.GEO'
8258 include 'COMMON.FFIELD'
8259 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8260 & auxvec1(2),auxmat1(2,2)
8262 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8264 C Parallel Antiparallel C
8270 C \ j|/k\| \ |/k\|l C
8275 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8277 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8278 C energy moment and not to the cluster cumulant.
8279 cd write (2,*) 'eello_graph4: wturn6',wturn6
8280 iti=itype2loc(itype(i))
8281 itj=itype2loc(itype(j))
8282 if (j.lt.nres-1) then
8283 itj1=itype2loc(itype(j+1))
8287 itk=itype2loc(itype(k))
8288 if (k.lt.nres-1) then
8289 itk1=itype2loc(itype(k+1))
8293 itl=itype2loc(itype(l))
8294 if (l.lt.nres-1) then
8295 itl1=itype2loc(itype(l+1))
8299 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8300 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8301 cd & ' itl',itl,' itl1',itl1
8304 s1=dip(3,jj,i)*dip(3,kk,k)
8306 s1=dip(2,jj,j)*dip(2,kk,l)
8309 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8310 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8312 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8313 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8315 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8316 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8318 call transpose2(EUg(1,1,k),auxmat(1,1))
8319 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8320 vv(1)=pizda(1,1)-pizda(2,2)
8321 vv(2)=pizda(2,1)+pizda(1,2)
8322 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8323 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8325 eello6_graph4=-(s1+s2+s3+s4)
8327 eello6_graph4=-(s2+s3+s4)
8329 C Derivatives in gamma(i-1)
8334 s1=dipderg(2,jj,i)*dip(3,kk,k)
8336 s1=dipderg(4,jj,j)*dip(2,kk,l)
8339 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8341 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8342 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8344 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8345 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8347 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8348 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8349 cd write (2,*) 'turn6 derivatives'
8351 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8353 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8357 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8359 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8363 C Derivatives in gamma(k-1)
8366 s1=dip(3,jj,i)*dipderg(2,kk,k)
8368 s1=dip(2,jj,j)*dipderg(4,kk,l)
8371 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8372 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8374 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8375 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8377 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8378 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8380 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8381 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8382 vv(1)=pizda(1,1)-pizda(2,2)
8383 vv(2)=pizda(2,1)+pizda(1,2)
8384 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8385 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8387 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8389 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8393 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8395 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8398 C Derivatives in gamma(j-1) or gamma(l-1)
8399 if (l.eq.j+1 .and. l.gt.1) then
8400 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8401 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8402 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8403 vv(1)=pizda(1,1)-pizda(2,2)
8404 vv(2)=pizda(2,1)+pizda(1,2)
8405 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8406 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8407 else if (j.gt.1) then
8408 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8409 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8410 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8411 vv(1)=pizda(1,1)-pizda(2,2)
8412 vv(2)=pizda(2,1)+pizda(1,2)
8413 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8414 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8415 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8417 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8420 C Cartesian derivatives.
8427 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8429 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8433 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8435 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8439 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8441 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8443 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8444 & b1(1,j+1),auxvec(1))
8445 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8447 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8448 & b1(1,l+1),auxvec(1))
8449 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8451 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8453 vv(1)=pizda(1,1)-pizda(2,2)
8454 vv(2)=pizda(2,1)+pizda(1,2)
8455 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8457 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8459 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8462 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8465 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8468 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8470 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8472 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8476 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8478 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8481 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8483 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8492 c----------------------------------------------------------------------------
8493 double precision function eello_turn6(i,jj,kk)
8494 implicit real*8 (a-h,o-z)
8495 include 'DIMENSIONS'
8496 include 'COMMON.IOUNITS'
8497 include 'COMMON.CHAIN'
8498 include 'COMMON.DERIV'
8499 include 'COMMON.INTERACT'
8500 include 'COMMON.CONTACTS'
8501 include 'COMMON.CONTMAT'
8502 include 'COMMON.CORRMAT'
8503 include 'COMMON.TORSION'
8504 include 'COMMON.VAR'
8505 include 'COMMON.GEO'
8506 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8507 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8509 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8510 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8511 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8512 C the respective energy moment and not to the cluster cumulant.
8521 iti=itype2loc(itype(i))
8522 itk=itype2loc(itype(k))
8523 itk1=itype2loc(itype(k+1))
8524 itl=itype2loc(itype(l))
8525 itj=itype2loc(itype(j))
8526 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8527 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8528 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8533 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8535 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8539 derx_turn(lll,kkk,iii)=0.0d0
8546 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8548 cd write (2,*) 'eello6_5',eello6_5
8550 call transpose2(AEA(1,1,1),auxmat(1,1))
8551 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8552 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8553 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8555 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8556 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8557 s2 = scalar2(b1(1,k),vtemp1(1))
8559 call transpose2(AEA(1,1,2),atemp(1,1))
8560 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8561 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8562 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8564 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8565 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8566 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8568 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8569 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8570 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8571 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8572 ss13 = scalar2(b1(1,k),vtemp4(1))
8573 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8575 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8581 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8582 C Derivatives in gamma(i+2)
8587 call transpose2(AEA(1,1,1),auxmatd(1,1))
8588 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8589 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8590 call transpose2(AEAderg(1,1,2),atempd(1,1))
8591 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8592 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8594 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8595 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8596 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8602 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8603 C Derivatives in gamma(i+3)
8605 call transpose2(AEA(1,1,1),auxmatd(1,1))
8606 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8607 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8608 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8610 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8611 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8612 s2d = scalar2(b1(1,k),vtemp1d(1))
8614 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8615 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8617 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8619 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8620 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8621 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8629 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8630 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8632 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8633 & -0.5d0*ekont*(s2d+s12d)
8635 C Derivatives in gamma(i+4)
8636 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8637 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8638 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8640 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8641 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8642 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8650 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8652 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8654 C Derivatives in gamma(i+5)
8656 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8657 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8658 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8660 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8661 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8662 s2d = scalar2(b1(1,k),vtemp1d(1))
8664 call transpose2(AEA(1,1,2),atempd(1,1))
8665 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8666 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8668 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8669 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8671 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8672 ss13d = scalar2(b1(1,k),vtemp4d(1))
8673 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8681 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8682 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8684 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8685 & -0.5d0*ekont*(s2d+s12d)
8687 C Cartesian derivatives
8692 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8693 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8694 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8696 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8697 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8699 s2d = scalar2(b1(1,k),vtemp1d(1))
8701 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8702 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8703 s8d = -(atempd(1,1)+atempd(2,2))*
8704 & scalar2(cc(1,1,l),vtemp2(1))
8706 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8708 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8709 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8716 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8719 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8723 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8724 & - 0.5d0*(s8d+s12d)
8726 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8735 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8737 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8738 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8739 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8740 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8741 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8743 ss13d = scalar2(b1(1,k),vtemp4d(1))
8744 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8745 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8749 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8750 cd & 16*eel_turn6_num
8752 if (j.lt.nres-1) then
8759 if (l.lt.nres-1) then
8767 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8768 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8769 cgrad ghalf=0.5d0*ggg1(ll)
8771 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8772 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8773 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8774 & +ekont*derx_turn(ll,2,1)
8775 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8776 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8777 & +ekont*derx_turn(ll,4,1)
8778 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8779 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8780 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8781 cgrad ghalf=0.5d0*ggg2(ll)
8783 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8784 & +ekont*derx_turn(ll,2,2)
8785 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8786 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8787 & +ekont*derx_turn(ll,4,2)
8788 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8789 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8790 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8795 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8800 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8806 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8811 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8815 cd write (2,*) iii,g_corr6_loc(iii)
8818 eello_turn6=ekont*eel_turn6
8819 cd write (2,*) 'ekont',ekont
8820 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8824 crc-------------------------------------------------
8825 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8826 subroutine Eliptransfer(eliptran)
8827 implicit real*8 (a-h,o-z)
8828 include 'DIMENSIONS'
8829 include 'COMMON.GEO'
8830 include 'COMMON.VAR'
8831 include 'COMMON.LOCAL'
8832 include 'COMMON.CHAIN'
8833 include 'COMMON.DERIV'
8834 include 'COMMON.INTERACT'
8835 include 'COMMON.IOUNITS'
8836 include 'COMMON.CALC'
8837 include 'COMMON.CONTROL'
8838 include 'COMMON.SPLITELE'
8839 include 'COMMON.SBRIDGE'
8840 C this is done by Adasko
8844 C--bordliptop-- buffore starts
8845 C--bufliptop--- here true lipid starts
8847 C--buflipbot--- lipid ends buffore starts
8848 C--bordlipbot--buffore ends
8852 if (itype(i).eq.ntyp1) cycle
8854 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8855 if (positi.le.0) positi=positi+boxzsize
8857 C first for peptide groups
8858 c for each residue check if it is in lipid or lipid water border area
8859 if ((positi.gt.bordlipbot)
8860 &.and.(positi.lt.bordliptop)) then
8861 C the energy transfer exist
8862 if (positi.lt.buflipbot) then
8863 C what fraction I am in
8865 & ((positi-bordlipbot)/lipbufthick)
8866 C lipbufthick is thickenes of lipid buffore
8867 sslip=sscalelip(fracinbuf)
8868 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8869 eliptran=eliptran+sslip*pepliptran
8870 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8871 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8872 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8873 elseif (positi.gt.bufliptop) then
8874 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8875 sslip=sscalelip(fracinbuf)
8876 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8877 eliptran=eliptran+sslip*pepliptran
8878 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8879 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8880 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8881 C print *, "doing sscalefor top part"
8882 C print *,i,sslip,fracinbuf,ssgradlip
8884 eliptran=eliptran+pepliptran
8885 C print *,"I am in true lipid"
8888 C eliptran=elpitran+0.0 ! I am in water
8891 C print *, "nic nie bylo w lipidzie?"
8892 C now multiply all by the peptide group transfer factor
8893 C eliptran=eliptran*pepliptran
8894 C now the same for side chains
8897 if (itype(i).eq.ntyp1) cycle
8898 positi=(mod(c(3,i+nres),boxzsize))
8899 if (positi.le.0) positi=positi+boxzsize
8900 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8901 c for each residue check if it is in lipid or lipid water border area
8902 C respos=mod(c(3,i+nres),boxzsize)
8903 C print *,positi,bordlipbot,buflipbot
8904 if ((positi.gt.bordlipbot)
8905 & .and.(positi.lt.bordliptop)) then
8906 C the energy transfer exist
8907 if (positi.lt.buflipbot) then
8909 & ((positi-bordlipbot)/lipbufthick)
8910 C lipbufthick is thickenes of lipid buffore
8911 sslip=sscalelip(fracinbuf)
8912 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8913 eliptran=eliptran+sslip*liptranene(itype(i))
8914 gliptranx(3,i)=gliptranx(3,i)
8915 &+ssgradlip*liptranene(itype(i))
8916 gliptranc(3,i-1)= gliptranc(3,i-1)
8917 &+ssgradlip*liptranene(itype(i))
8918 C print *,"doing sccale for lower part"
8919 elseif (positi.gt.bufliptop) then
8921 &((bordliptop-positi)/lipbufthick)
8922 sslip=sscalelip(fracinbuf)
8923 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8924 eliptran=eliptran+sslip*liptranene(itype(i))
8925 gliptranx(3,i)=gliptranx(3,i)
8926 &+ssgradlip*liptranene(itype(i))
8927 gliptranc(3,i-1)= gliptranc(3,i-1)
8928 &+ssgradlip*liptranene(itype(i))
8929 C print *, "doing sscalefor top part",sslip,fracinbuf
8931 eliptran=eliptran+liptranene(itype(i))
8932 C print *,"I am in true lipid"
8934 endif ! if in lipid or buffor
8936 C eliptran=elpitran+0.0 ! I am in water
8942 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8944 SUBROUTINE MATVEC2(A1,V1,V2)
8945 implicit real*8 (a-h,o-z)
8946 include 'DIMENSIONS'
8947 DIMENSION A1(2,2),V1(2),V2(2)
8951 c 3 VI=VI+A1(I,K)*V1(K)
8955 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8956 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8961 C---------------------------------------
8962 SUBROUTINE MATMAT2(A1,A2,A3)
8963 implicit real*8 (a-h,o-z)
8964 include 'DIMENSIONS'
8965 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8966 c DIMENSION AI3(2,2)
8970 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8976 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8977 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8978 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8979 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8987 c-------------------------------------------------------------------------
8988 double precision function scalar2(u,v)
8990 double precision u(2),v(2)
8993 scalar2=u(1)*v(1)+u(2)*v(2)
8997 C-----------------------------------------------------------------------------
8999 subroutine transpose2(a,at)
9001 double precision a(2,2),at(2,2)
9008 c--------------------------------------------------------------------------
9009 subroutine transpose(n,a,at)
9012 double precision a(n,n),at(n,n)
9020 C---------------------------------------------------------------------------
9021 subroutine prodmat3(a1,a2,kk,transp,prod)
9024 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9026 crc double precision auxmat(2,2),prod_(2,2)
9029 crc call transpose2(kk(1,1),auxmat(1,1))
9030 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9031 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9033 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9034 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9035 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9036 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9037 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9038 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9039 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9040 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9043 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9044 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9046 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9047 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9048 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9049 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9050 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9051 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9052 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9053 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9056 c call transpose2(a2(1,1),a2t(1,1))
9059 crc print *,((prod_(i,j),i=1,2),j=1,2)
9060 crc print *,((prod(i,j),i=1,2),j=1,2)
9064 C-----------------------------------------------------------------------------
9065 double precision function scalar(u,v)
9067 double precision u(3),v(3)
9077 C-----------------------------------------------------------------------
9078 double precision function sscale(r)
9079 double precision r,gamm
9080 include "COMMON.SPLITELE"
9081 if(r.lt.r_cut-rlamb) then
9083 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9084 gamm=(r-(r_cut-rlamb))/rlamb
9085 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9091 C-----------------------------------------------------------------------
9092 C-----------------------------------------------------------------------
9093 double precision function sscagrad(r)
9094 double precision r,gamm
9095 include "COMMON.SPLITELE"
9096 if(r.lt.r_cut-rlamb) then
9098 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9099 gamm=(r-(r_cut-rlamb))/rlamb
9100 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9106 C-----------------------------------------------------------------------
9107 C-----------------------------------------------------------------------
9108 double precision function sscalelip(r)
9109 double precision r,gamm
9110 include "COMMON.SPLITELE"
9111 C if(r.lt.r_cut-rlamb) then
9113 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9114 C gamm=(r-(r_cut-rlamb))/rlamb
9115 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9121 C-----------------------------------------------------------------------
9122 double precision function sscagradlip(r)
9123 double precision r,gamm
9124 include "COMMON.SPLITELE"
9125 C if(r.lt.r_cut-rlamb) then
9127 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9128 C gamm=(r-(r_cut-rlamb))/rlamb
9129 sscagradlip=r*(6*r-6.0d0)
9136 C-----------------------------------------------------------------------
9137 subroutine set_shield_fac
9138 implicit real*8 (a-h,o-z)
9139 include 'DIMENSIONS'
9140 include 'COMMON.CHAIN'
9141 include 'COMMON.DERIV'
9142 include 'COMMON.IOUNITS'
9143 include 'COMMON.SHIELD'
9144 include 'COMMON.INTERACT'
9145 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9146 double precision div77_81/0.974996043d0/,
9147 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9149 C the vector between center of side_chain and peptide group
9150 double precision pep_side(3),long,side_calf(3),
9151 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9152 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9153 C the line belowe needs to be changed for FGPROC>1
9155 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9157 Cif there two consequtive dummy atoms there is no peptide group between them
9158 C the line below has to be changed for FGPROC>1
9161 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9165 C first lets set vector conecting the ithe side-chain with kth side-chain
9166 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9168 C and vector conecting the side-chain with its proper calfa
9169 side_calf(j)=c(j,k+nres)-c(j,k)
9170 C side_calf(j)=2.0d0
9171 pept_group(j)=c(j,i)-c(j,i+1)
9172 C lets have their lenght
9173 dist_pep_side=pep_side(j)**2+dist_pep_side
9174 dist_side_calf=dist_side_calf+side_calf(j)**2
9175 dist_pept_group=dist_pept_group+pept_group(j)**2
9177 dist_pep_side=dsqrt(dist_pep_side)
9178 dist_pept_group=dsqrt(dist_pept_group)
9179 dist_side_calf=dsqrt(dist_side_calf)
9181 pep_side_norm(j)=pep_side(j)/dist_pep_side
9182 side_calf_norm(j)=dist_side_calf
9184 C now sscale fraction
9185 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9186 C print *,buff_shield,"buff"
9188 if (sh_frac_dist.le.0.0) cycle
9189 C If we reach here it means that this side chain reaches the shielding sphere
9190 C Lets add him to the list for gradient
9191 ishield_list(i)=ishield_list(i)+1
9192 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9193 C this list is essential otherwise problem would be O3
9194 shield_list(ishield_list(i),i)=k
9195 C Lets have the sscale value
9196 if (sh_frac_dist.gt.1.0) then
9197 scale_fac_dist=1.0d0
9199 sh_frac_dist_grad(j)=0.0d0
9202 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9203 & *(2.0*sh_frac_dist-3.0d0)
9204 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9205 & /dist_pep_side/buff_shield*0.5
9206 C remember for the final gradient multiply sh_frac_dist_grad(j)
9207 C for side_chain by factor -2 !
9209 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9210 C print *,"jestem",scale_fac_dist,fac_help_scale,
9211 C & sh_frac_dist_grad(j)
9214 C if ((i.eq.3).and.(k.eq.2)) then
9215 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9219 C this is what is now we have the distance scaling now volume...
9220 short=short_r_sidechain(itype(k))
9221 long=long_r_sidechain(itype(k))
9222 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9225 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9228 costhet_grad(j)=costhet_fac*pep_side(j)
9230 C remember for the final gradient multiply costhet_grad(j)
9231 C for side_chain by factor -2 !
9232 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9233 C pep_side0pept_group is vector multiplication
9234 pep_side0pept_group=0.0
9236 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9238 cosalfa=(pep_side0pept_group/
9239 & (dist_pep_side*dist_side_calf))
9240 fac_alfa_sin=1.0-cosalfa**2
9241 fac_alfa_sin=dsqrt(fac_alfa_sin)
9242 rkprim=fac_alfa_sin*(long-short)+short
9244 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9245 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9248 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9249 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9250 &*(long-short)/fac_alfa_sin*cosalfa/
9251 &((dist_pep_side*dist_side_calf))*
9252 &((side_calf(j))-cosalfa*
9253 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9255 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9256 &*(long-short)/fac_alfa_sin*cosalfa
9257 &/((dist_pep_side*dist_side_calf))*
9259 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9262 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9265 C now the gradient...
9266 C grad_shield is gradient of Calfa for peptide groups
9267 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9269 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9270 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9272 grad_shield(j,i)=grad_shield(j,i)
9273 C gradient po skalowaniu
9274 & +(sh_frac_dist_grad(j)
9275 C gradient po costhet
9276 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9277 &-scale_fac_dist*(cosphi_grad_long(j))
9278 &/(1.0-cosphi) )*div77_81
9280 C grad_shield_side is Cbeta sidechain gradient
9281 grad_shield_side(j,ishield_list(i),i)=
9282 & (sh_frac_dist_grad(j)*(-2.0d0)
9283 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9284 & +scale_fac_dist*(cosphi_grad_long(j))
9285 & *2.0d0/(1.0-cosphi))
9286 & *div77_81*VofOverlap
9288 grad_shield_loc(j,ishield_list(i),i)=
9289 & scale_fac_dist*cosphi_grad_loc(j)
9290 & *2.0d0/(1.0-cosphi)
9291 & *div77_81*VofOverlap
9293 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9295 fac_shield(i)=VolumeTotal*div77_81+div4_81
9296 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9300 C--------------------------------------------------------------------------
9301 C first for shielding is setting of function of side-chains
9302 subroutine set_shield_fac2
9303 implicit real*8 (a-h,o-z)
9304 include 'DIMENSIONS'
9305 include 'COMMON.CHAIN'
9306 include 'COMMON.DERIV'
9307 include 'COMMON.IOUNITS'
9308 include 'COMMON.SHIELD'
9309 include 'COMMON.INTERACT'
9310 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9311 double precision div77_81/0.974996043d0/,
9312 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9314 C the vector between center of side_chain and peptide group
9315 double precision pep_side(3),long,side_calf(3),
9316 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9317 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9318 C the line belowe needs to be changed for FGPROC>1
9320 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9322 Cif there two consequtive dummy atoms there is no peptide group between them
9323 C the line below has to be changed for FGPROC>1
9326 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9330 C first lets set vector conecting the ithe side-chain with kth side-chain
9331 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9333 C and vector conecting the side-chain with its proper calfa
9334 side_calf(j)=c(j,k+nres)-c(j,k)
9335 C side_calf(j)=2.0d0
9336 pept_group(j)=c(j,i)-c(j,i+1)
9337 C lets have their lenght
9338 dist_pep_side=pep_side(j)**2+dist_pep_side
9339 dist_side_calf=dist_side_calf+side_calf(j)**2
9340 dist_pept_group=dist_pept_group+pept_group(j)**2
9342 dist_pep_side=dsqrt(dist_pep_side)
9343 dist_pept_group=dsqrt(dist_pept_group)
9344 dist_side_calf=dsqrt(dist_side_calf)
9346 pep_side_norm(j)=pep_side(j)/dist_pep_side
9347 side_calf_norm(j)=dist_side_calf
9349 C now sscale fraction
9350 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9351 C print *,buff_shield,"buff"
9353 if (sh_frac_dist.le.0.0) cycle
9354 C If we reach here it means that this side chain reaches the shielding sphere
9355 C Lets add him to the list for gradient
9356 ishield_list(i)=ishield_list(i)+1
9357 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9358 C this list is essential otherwise problem would be O3
9359 shield_list(ishield_list(i),i)=k
9360 C Lets have the sscale value
9361 if (sh_frac_dist.gt.1.0) then
9362 scale_fac_dist=1.0d0
9364 sh_frac_dist_grad(j)=0.0d0
9367 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9368 & *(2.0d0*sh_frac_dist-3.0d0)
9369 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9370 & /dist_pep_side/buff_shield*0.5d0
9371 C remember for the final gradient multiply sh_frac_dist_grad(j)
9372 C for side_chain by factor -2 !
9374 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9375 C sh_frac_dist_grad(j)=0.0d0
9376 C scale_fac_dist=1.0d0
9377 C print *,"jestem",scale_fac_dist,fac_help_scale,
9378 C & sh_frac_dist_grad(j)
9381 C this is what is now we have the distance scaling now volume...
9382 short=short_r_sidechain(itype(k))
9383 long=long_r_sidechain(itype(k))
9384 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9385 sinthet=short/dist_pep_side*costhet
9389 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9390 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9391 C & -short/dist_pep_side**2/costhet)
9394 costhet_grad(j)=costhet_fac*pep_side(j)
9396 C remember for the final gradient multiply costhet_grad(j)
9397 C for side_chain by factor -2 !
9398 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9399 C pep_side0pept_group is vector multiplication
9400 pep_side0pept_group=0.0d0
9402 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9404 cosalfa=(pep_side0pept_group/
9405 & (dist_pep_side*dist_side_calf))
9406 fac_alfa_sin=1.0d0-cosalfa**2
9407 fac_alfa_sin=dsqrt(fac_alfa_sin)
9408 rkprim=fac_alfa_sin*(long-short)+short
9412 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9414 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9415 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9419 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9420 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9421 &*(long-short)/fac_alfa_sin*cosalfa/
9422 &((dist_pep_side*dist_side_calf))*
9423 &((side_calf(j))-cosalfa*
9424 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9425 C cosphi_grad_long(j)=0.0d0
9426 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9427 &*(long-short)/fac_alfa_sin*cosalfa
9428 &/((dist_pep_side*dist_side_calf))*
9430 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9431 C cosphi_grad_loc(j)=0.0d0
9433 C print *,sinphi,sinthet
9434 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9437 C now the gradient...
9439 grad_shield(j,i)=grad_shield(j,i)
9440 C gradient po skalowaniu
9441 & +(sh_frac_dist_grad(j)*VofOverlap
9442 C gradient po costhet
9443 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9444 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9445 & sinphi/sinthet*costhet*costhet_grad(j)
9446 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9448 C grad_shield_side is Cbeta sidechain gradient
9449 grad_shield_side(j,ishield_list(i),i)=
9450 & (sh_frac_dist_grad(j)*(-2.0d0)
9452 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9453 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9454 & sinphi/sinthet*costhet*costhet_grad(j)
9455 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9458 grad_shield_loc(j,ishield_list(i),i)=
9459 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9460 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9461 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9465 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9467 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9468 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9469 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9473 C--------------------------------------------------------------------------
9474 double precision function tschebyshev(m,n,x,y)
9476 include "DIMENSIONS"
9478 double precision x(n),y,yy(0:maxvar),aux
9479 c Tschebyshev polynomial. Note that the first term is omitted
9480 c m=0: the constant term is included
9481 c m=1: the constant term is not included
9485 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9494 C--------------------------------------------------------------------------
9495 double precision function gradtschebyshev(m,n,x,y)
9497 include "DIMENSIONS"
9499 double precision x(n+1),y,yy(0:maxvar),aux
9500 c Tschebyshev polynomial. Note that the first term is omitted
9501 c m=0: the constant term is included
9502 c m=1: the constant term is not included
9506 yy(i)=2*y*yy(i-1)-yy(i-2)
9510 aux=aux+x(i+1)*yy(i)*(i+1)
9511 C print *, x(i+1),yy(i),i
9516 c----------------------------------------------------------------------------
9517 double precision function sscale2(r,r_cut,r0,rlamb)
9519 double precision r,gamm,r_cut,r0,rlamb,rr
9521 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9522 c write (2,*) "rr",rr
9523 if(rr.lt.r_cut-rlamb) then
9525 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9526 gamm=(rr-(r_cut-rlamb))/rlamb
9527 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9533 C-----------------------------------------------------------------------
9534 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9536 double precision r,gamm,r_cut,r0,rlamb,rr
9538 if(rr.lt.r_cut-rlamb) then
9540 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9541 gamm=(rr-(r_cut-rlamb))/rlamb
9543 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9545 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9552 c----------------------------------------------------------------------------
9553 subroutine e_saxs(Esaxs_constr)
9555 include 'DIMENSIONS'
9558 include "COMMON.SETUP"
9561 include 'COMMON.SBRIDGE'
9562 include 'COMMON.CHAIN'
9563 include 'COMMON.GEO'
9564 include 'COMMON.LOCAL'
9565 include 'COMMON.INTERACT'
9566 include 'COMMON.VAR'
9567 include 'COMMON.IOUNITS'
9568 include 'COMMON.DERIV'
9569 include 'COMMON.CONTROL'
9570 include 'COMMON.NAMES'
9571 include 'COMMON.FFIELD'
9572 include 'COMMON.LANGEVIN'
9573 include 'COMMON.SAXS'
9575 double precision Esaxs_constr
9576 integer i,iint,j,k,l
9577 double precision PgradC(maxSAXS,3,maxres),
9578 & PgradX(maxSAXS,3,maxres)
9580 double precision PgradC_(maxSAXS,3,maxres),
9581 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9583 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9584 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9585 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9586 & auxX,auxX1,CACAgrad,Cnorm
9587 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9588 double precision dist
9590 c SAXS restraint penalty function
9592 write(iout,*) "------- SAXS penalty function start -------"
9593 write (iout,*) "nsaxs",nsaxs
9594 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9595 write (iout,*) "Psaxs"
9597 write (iout,'(i5,e15.5)') i, Psaxs(i)
9600 Esaxs_constr = 0.0d0
9610 do i=iatsc_s,iatsc_e
9611 if (itype(i).eq.ntyp1) cycle
9612 do iint=1,nint_gr(i)
9613 do j=istart(i,iint),iend(i,iint)
9614 if (itype(j).eq.ntyp1) cycle
9617 dijCASC=dist(i,j+nres)
9618 dijSCCA=dist(i+nres,j)
9619 dijSCSC=dist(i+nres,j+nres)
9620 sigma2CACA=2.0d0/(pstok**2)
9621 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9622 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9623 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9626 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9627 if (itype(j).ne.10) then
9628 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9632 if (itype(i).ne.10) then
9633 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9637 if (itype(i).ne.10 .and. itype(j).ne.10) then
9638 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9642 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9644 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9646 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9647 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9648 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9649 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9652 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9653 PgradC(k,l,i) = PgradC(k,l,i)-aux
9654 PgradC(k,l,j) = PgradC(k,l,j)+aux
9656 if (itype(j).ne.10) then
9657 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9658 PgradC(k,l,i) = PgradC(k,l,i)-aux
9659 PgradC(k,l,j) = PgradC(k,l,j)+aux
9660 PgradX(k,l,j) = PgradX(k,l,j)+aux
9663 if (itype(i).ne.10) then
9664 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9665 PgradX(k,l,i) = PgradX(k,l,i)-aux
9666 PgradC(k,l,i) = PgradC(k,l,i)-aux
9667 PgradC(k,l,j) = PgradC(k,l,j)+aux
9670 if (itype(i).ne.10 .and. itype(j).ne.10) then
9671 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9672 PgradC(k,l,i) = PgradC(k,l,i)-aux
9673 PgradC(k,l,j) = PgradC(k,l,j)+aux
9674 PgradX(k,l,i) = PgradX(k,l,i)-aux
9675 PgradX(k,l,j) = PgradX(k,l,j)+aux
9681 sigma2CACA=scal_rad**2*0.25d0/
9682 & (restok(itype(j))**2+restok(itype(i))**2)
9684 IF (saxs_cutoff.eq.0) THEN
9687 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9688 Pcalc(k) = Pcalc(k)+expCACA
9689 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9691 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9692 PgradC(k,l,i) = PgradC(k,l,i)-aux
9693 PgradC(k,l,j) = PgradC(k,l,j)+aux
9697 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9700 c write (2,*) "ijk",i,j,k
9701 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9702 if (sss2.eq.0.0d0) cycle
9703 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9704 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9705 Pcalc(k) = Pcalc(k)+expCACA
9707 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9709 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9710 & ssgrad2*expCACA/sss2
9713 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9714 PgradC(k,l,i) = PgradC(k,l,i)+aux
9715 PgradC(k,l,j) = PgradC(k,l,j)-aux
9724 if (nfgtasks.gt.1) then
9725 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9726 & MPI_SUM,king,FG_COMM,IERR)
9727 if (fg_rank.eq.king) then
9729 Pcalc(k) = Pcalc_(k)
9732 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9733 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9734 if (fg_rank.eq.king) then
9738 PgradC(k,l,i) = PgradC_(k,l,i)
9744 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9745 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9746 if (fg_rank.eq.king) then
9750 PgradX(k,l,i) = PgradX_(k,l,i)
9759 if (fg_rank.eq.king) then
9763 Cnorm = Cnorm + Pcalc(k)
9765 Esaxs_constr = dlog(Cnorm)-wsaxs0
9767 if (Pcalc(k).gt.0.0d0)
9768 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9770 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9774 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9784 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9785 auxC1 = auxC1+PgradC(k,l,i)
9787 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9788 auxX1 = auxX1+PgradX(k,l,i)
9791 gsaxsC(l,i) = auxC - auxC1/Cnorm
9793 gsaxsX(l,i) = auxX - auxX1/Cnorm
9795 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9796 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9804 c----------------------------------------------------------------------------
9805 subroutine e_saxsC(Esaxs_constr)
9807 include 'DIMENSIONS'
9810 include "COMMON.SETUP"
9813 include 'COMMON.SBRIDGE'
9814 include 'COMMON.CHAIN'
9815 include 'COMMON.GEO'
9816 include 'COMMON.LOCAL'
9817 include 'COMMON.INTERACT'
9818 include 'COMMON.VAR'
9819 include 'COMMON.IOUNITS'
9820 include 'COMMON.DERIV'
9821 include 'COMMON.CONTROL'
9822 include 'COMMON.NAMES'
9823 include 'COMMON.FFIELD'
9824 include 'COMMON.LANGEVIN'
9825 include 'COMMON.SAXS'
9827 double precision Esaxs_constr
9828 integer i,iint,j,k,l
9829 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc_,logPtot
9831 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9833 double precision dk,dijCASPH,dijSCSPH,
9834 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9835 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
9837 c SAXS restraint penalty function
9839 write(iout,*) "------- SAXS penalty function start -------"
9840 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
9841 & " isaxs_end",isaxs_end
9842 write (iout,*) "nnt",nnt," ntc",nct
9844 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9845 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9848 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9851 Esaxs_constr = 0.0d0
9853 do j=isaxs_start,isaxs_end
9865 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9867 if (itype(i).ne.10) then
9869 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9872 sigma2CA=2.0d0/pstok**2
9873 sigma2SC=4.0d0/restok(itype(i))**2
9874 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9875 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9876 Pcalc_ = Pcalc_+expCASPH+expSCSPH
9878 write(*,*) "processor i j Pcalc",
9879 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc_
9881 CASPHgrad = sigma2CA*expCASPH
9882 SCSPHgrad = sigma2SC*expSCSPH
9884 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9885 PgradX(l,i) = PgradX(l,i) + aux
9886 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9891 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc_
9892 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc_
9895 logPtot = logPtot - dlog(Pcalc_)
9896 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc_),
9897 c & " logPtot",logPtot
9900 if (nfgtasks.gt.1) then
9901 c write (iout,*) "logPtot before reduction",logPtot
9902 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9903 & MPI_SUM,king,FG_COMM,IERR)
9905 c write (iout,*) "logPtot after reduction",logPtot
9906 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9907 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9908 if (fg_rank.eq.king) then
9911 gsaxsC(l,i) = gsaxsC_(l,i)
9915 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9916 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9917 if (fg_rank.eq.king) then
9920 gsaxsX(l,i) = gsaxsX_(l,i)
9926 Esaxs_constr = logPtot
9929 C--------------------------------------------------------------------------
9930 c MODELLER restraint function
9931 subroutine e_modeller(ehomology_constr)
9932 implicit real*8 (a-h,o-z)
9933 include 'DIMENSIONS'
9934 integer nnn, i, j, k, ki, irec, l
9935 integer katy, odleglosci, test7
9936 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
9937 real*8 distance(max_template),distancek(max_template),
9938 & min_odl,godl(max_template),dih_diff(max_template)
9941 c FP - 30/10/2014 Temporary specifications for homology restraints
9943 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
9945 double precision, dimension (maxres) :: guscdiff,usc_diff
9946 double precision, dimension (max_template) ::
9947 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
9950 include 'COMMON.SBRIDGE'
9951 include 'COMMON.CHAIN'
9952 include 'COMMON.GEO'
9953 include 'COMMON.DERIV'
9954 include 'COMMON.LOCAL'
9955 include 'COMMON.INTERACT'
9956 include 'COMMON.VAR'
9957 include 'COMMON.IOUNITS'
9958 include 'COMMON.CONTROL'
9959 include 'COMMON.HOMRESTR'
9960 include 'COMMON.HOMOLOGY'
9961 include 'COMMON.SETUP'
9962 include 'COMMON.NAMES'
9965 distancek(i)=9999999.9
9970 c Pseudo-energy and gradient from homology restraints (MODELLER-like
9972 C AL 5/2/14 - Introduce list of restraints
9973 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
9975 write(iout,*) "------- dist restrs start -------"
9977 do ii = link_start_homo,link_end_homo
9981 c write (iout,*) "dij(",i,j,") =",dij
9983 do k=1,constr_homology
9984 if(.not.l_homo(k,ii)) then
9988 distance(k)=odl(k,ii)-dij
9989 c write (iout,*) "distance(",k,") =",distance(k)
9991 c For Gaussian-type Urestr
9993 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
9994 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
9995 c write (iout,*) "distancek(",k,") =",distancek(k)
9996 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
9998 c For Lorentzian-type Urestr
10000 if (waga_dist.lt.0.0d0) then
10001 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
10002 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
10003 & (distance(k)**2+sigma_odlir(k,ii)**2))
10007 c min_odl=minval(distancek)
10008 if (nexl.gt.0) then
10011 do kk=1,constr_homology
10012 if(l_homo(kk,ii)) then
10013 min_odl=distancek(kk)
10017 do kk=1,constr_homology
10018 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
10019 & min_odl=distancek(kk)
10022 c write (iout,* )"min_odl",min_odl
10024 write (iout,*) "ij dij",i,j,dij
10025 write (iout,*) "distance",(distance(k),k=1,constr_homology)
10026 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
10027 write (iout,* )"min_odl",min_odl
10032 if (waga_dist.ge.0.0d0) then
10038 do k=1,constr_homology
10039 c Nie wiem po co to liczycie jeszcze raz!
10040 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
10041 c & (2*(sigma_odl(i,j,k))**2))
10042 if(.not.l_homo(k,ii)) cycle
10043 if (waga_dist.ge.0.0d0) then
10045 c For Gaussian-type Urestr
10047 godl(k)=dexp(-distancek(k)+min_odl)
10048 odleg2=odleg2+godl(k)
10050 c For Lorentzian-type Urestr
10053 odleg2=odleg2+distancek(k)
10056 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
10057 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
10058 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
10059 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
10062 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10063 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10065 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10066 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10068 if (waga_dist.ge.0.0d0) then
10070 c For Gaussian-type Urestr
10072 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
10074 c For Lorentzian-type Urestr
10077 odleg=odleg+odleg2/constr_homology
10081 c write (iout,*) "odleg",odleg ! sum of -ln-s
10084 c For Gaussian-type Urestr
10086 if (waga_dist.ge.0.0d0) sum_godl=odleg2
10088 do k=1,constr_homology
10089 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10090 c & *waga_dist)+min_odl
10091 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
10093 if(.not.l_homo(k,ii)) cycle
10094 if (waga_dist.ge.0.0d0) then
10095 c For Gaussian-type Urestr
10097 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
10099 c For Lorentzian-type Urestr
10102 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
10103 & sigma_odlir(k,ii)**2)**2)
10105 sum_sgodl=sum_sgodl+sgodl
10107 c sgodl2=sgodl2+sgodl
10108 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
10109 c write(iout,*) "constr_homology=",constr_homology
10110 c write(iout,*) i, j, k, "TEST K"
10112 if (waga_dist.ge.0.0d0) then
10114 c For Gaussian-type Urestr
10116 grad_odl3=waga_homology(iset)*waga_dist
10117 & *sum_sgodl/(sum_godl*dij)
10119 c For Lorentzian-type Urestr
10122 c Original grad expr modified by analogy w Gaussian-type Urestr grad
10123 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
10124 grad_odl3=-waga_homology(iset)*waga_dist*
10125 & sum_sgodl/(constr_homology*dij)
10128 c grad_odl3=sum_sgodl/(sum_godl*dij)
10131 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
10132 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
10133 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10135 ccc write(iout,*) godl, sgodl, grad_odl3
10137 c grad_odl=grad_odl+grad_odl3
10140 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
10141 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
10142 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
10143 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10144 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
10145 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
10146 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
10147 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10148 c if (i.eq.25.and.j.eq.27) then
10149 c write(iout,*) "jik",jik,"i",i,"j",j
10150 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
10151 c write(iout,*) "grad_odl3",grad_odl3
10152 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
10153 c write(iout,*) "ggodl",ggodl
10154 c write(iout,*) "ghpbc(",jik,i,")",
10155 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
10160 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
10161 ccc & dLOG(odleg2),"-odleg=", -odleg
10163 enddo ! ii-loop for dist
10165 write(iout,*) "------- dist restrs end -------"
10166 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
10167 c & waga_d.eq.1.0d0) call sum_gradient
10169 c Pseudo-energy and gradient from dihedral-angle restraints from
10170 c homology templates
10171 c write (iout,*) "End of distance loop"
10174 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
10176 write(iout,*) "------- dih restrs start -------"
10177 do i=idihconstr_start_homo,idihconstr_end_homo
10178 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
10181 do i=idihconstr_start_homo,idihconstr_end_homo
10183 c betai=beta(i,i+1,i+2,i+3)
10185 c write (iout,*) "betai =",betai
10186 do k=1,constr_homology
10187 dih_diff(k)=pinorm(dih(k,i)-betai)
10188 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
10189 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
10190 c & -(6.28318-dih_diff(i,k))
10191 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
10192 c & 6.28318+dih_diff(i,k)
10194 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
10196 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
10198 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
10201 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
10204 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
10205 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
10207 write (iout,*) "i",i," betai",betai," kat2",kat2
10208 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
10210 if (kat2.le.1.0d-14) cycle
10211 kat=kat-dLOG(kat2/constr_homology)
10212 c write (iout,*) "kat",kat ! sum of -ln-s
10214 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
10215 ccc & dLOG(kat2), "-kat=", -kat
10218 c ----------------------------------------------------------------------
10220 c ----------------------------------------------------------------------
10224 do k=1,constr_homology
10226 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
10228 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
10230 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
10231 sum_sgdih=sum_sgdih+sgdih
10233 c grad_dih3=sum_sgdih/sum_gdih
10234 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
10236 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
10237 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
10238 ccc & gloc(nphi+i-3,icg)
10239 gloc(i,icg)=gloc(i,icg)+grad_dih3
10240 c if (i.eq.25) then
10241 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
10243 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
10244 ccc & gloc(nphi+i-3,icg)
10246 enddo ! i-loop for dih
10248 write(iout,*) "------- dih restrs end -------"
10251 c Pseudo-energy and gradient for theta angle restraints from
10252 c homology templates
10253 c FP 01/15 - inserted from econstr_local_test.F, loop structure
10257 c For constr_homology reference structures (FP)
10259 c Uconst_back_tot=0.0d0
10262 c Econstr_back legacy
10265 c do i=ithet_start,ithet_end
10268 c do i=loc_start,loc_end
10270 duscdiff(j,i)=0.0d0
10271 duscdiffx(j,i)=0.0d0
10277 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
10278 c write (iout,*) "waga_theta",waga_theta
10279 if (waga_theta.gt.0.0d0) then
10281 write (iout,*) "usampl",usampl
10282 write(iout,*) "------- theta restrs start -------"
10283 c do i=ithet_start,ithet_end
10284 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
10287 c write (iout,*) "maxres",maxres,"nres",nres
10289 do i=ithet_start,ithet_end
10291 c do i=1,nfrag_back
10292 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10294 c Deviation of theta angles wrt constr_homology ref structures
10296 utheta_i=0.0d0 ! argument of Gaussian for single k
10297 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10298 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
10299 c over residues in a fragment
10300 c write (iout,*) "theta(",i,")=",theta(i)
10301 do k=1,constr_homology
10303 c dtheta_i=theta(j)-thetaref(j,iref)
10304 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
10305 theta_diff(k)=thetatpl(k,i)-theta(i)
10307 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
10308 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
10309 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
10310 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
10311 c Gradient for single Gaussian restraint in subr Econstr_back
10312 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10315 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
10316 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
10320 c Gradient for multiple Gaussian restraint
10321 sum_gtheta=gutheta_i
10323 do k=1,constr_homology
10324 c New generalized expr for multiple Gaussian from Econstr_back
10325 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
10327 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
10328 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
10331 c Final value of gradient using same var as in Econstr_back
10332 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
10333 & *waga_homology(iset)
10334 c dutheta(i)=sum_sgtheta/sum_gtheta
10336 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
10338 Eval=Eval-dLOG(gutheta_i/constr_homology)
10339 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
10340 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
10341 c Uconst_back=Uconst_back+utheta(i)
10342 enddo ! (i-loop for theta)
10344 write(iout,*) "------- theta restrs end -------"
10348 c Deviation of local SC geometry
10350 c Separation of two i-loops (instructed by AL - 11/3/2014)
10352 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
10353 c write (iout,*) "waga_d",waga_d
10356 write(iout,*) "------- SC restrs start -------"
10357 write (iout,*) "Initial duscdiff,duscdiffx"
10358 do i=loc_start,loc_end
10359 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
10360 & (duscdiffx(jik,i),jik=1,3)
10363 do i=loc_start,loc_end
10364 usc_diff_i=0.0d0 ! argument of Gaussian for single k
10365 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10366 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
10367 c write(iout,*) "xxtab, yytab, zztab"
10368 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
10369 do k=1,constr_homology
10371 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10372 c Original sign inverted for calc of gradients (s. Econstr_back)
10373 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10374 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10375 c write(iout,*) "dxx, dyy, dzz"
10376 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10378 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
10379 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
10380 c uscdiffk(k)=usc_diff(i)
10381 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
10382 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
10383 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10384 c & xxref(j),yyref(j),zzref(j)
10389 c Generalized expression for multiple Gaussian acc to that for a single
10390 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
10392 c Original implementation
10393 c sum_guscdiff=guscdiff(i)
10395 c sum_sguscdiff=0.0d0
10396 c do k=1,constr_homology
10397 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
10398 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
10399 c sum_sguscdiff=sum_sguscdiff+sguscdiff
10402 c Implementation of new expressions for gradient (Jan. 2015)
10404 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
10406 do k=1,constr_homology
10408 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
10409 c before. Now the drivatives should be correct
10411 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10412 c Original sign inverted for calc of gradients (s. Econstr_back)
10413 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10414 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10416 c New implementation
10418 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
10419 & sigma_d(k,i) ! for the grad wrt r'
10420 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
10423 c New implementation
10424 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
10426 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
10427 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
10428 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
10429 duscdiff(jik,i)=duscdiff(jik,i)+
10430 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
10431 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
10432 duscdiffx(jik,i)=duscdiffx(jik,i)+
10433 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
10434 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
10437 write(iout,*) "jik",jik,"i",i
10438 write(iout,*) "dxx, dyy, dzz"
10439 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10440 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
10441 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
10442 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
10443 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
10444 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
10445 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
10446 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
10447 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
10448 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
10449 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
10450 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
10451 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
10452 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
10453 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
10460 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
10461 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
10463 c write (iout,*) i," uscdiff",uscdiff(i)
10465 c Put together deviations from local geometry
10467 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
10468 c & wfrag_back(3,i,iset)*uscdiff(i)
10469 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
10470 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
10471 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
10472 c Uconst_back=Uconst_back+usc_diff(i)
10474 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
10476 c New implment: multiplied by sum_sguscdiff
10479 enddo ! (i-loop for dscdiff)
10484 write(iout,*) "------- SC restrs end -------"
10485 write (iout,*) "------ After SC loop in e_modeller ------"
10486 do i=loc_start,loc_end
10487 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
10488 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
10490 if (waga_theta.eq.1.0d0) then
10491 write (iout,*) "in e_modeller after SC restr end: dutheta"
10492 do i=ithet_start,ithet_end
10493 write (iout,*) i,dutheta(i)
10496 if (waga_d.eq.1.0d0) then
10497 write (iout,*) "e_modeller after SC loop: duscdiff/x"
10499 write (iout,*) i,(duscdiff(j,i),j=1,3)
10500 write (iout,*) i,(duscdiffx(j,i),j=1,3)
10505 c Total energy from homology restraints
10507 write (iout,*) "odleg",odleg," kat",kat
10508 write (iout,*) "odleg",odleg," kat",kat
10509 write (iout,*) "Eval",Eval," Erot",Erot
10510 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
10511 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
10512 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
10515 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
10517 c ehomology_constr=odleg+kat
10519 c For Lorentzian-type Urestr
10522 if (waga_dist.ge.0.0d0) then
10524 c For Gaussian-type Urestr
10526 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
10527 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10528 ehomology_constr=waga_dist*odleg+waga_angle*kat+
10529 & waga_theta*Eval+waga_d*Erot
10530 c write (iout,*) "ehomology_constr=",ehomology_constr
10533 c For Lorentzian-type Urestr
10535 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
10536 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10537 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
10538 & waga_theta*Eval+waga_d*Erot
10539 c write (iout,*) "ehomology_constr=",ehomology_constr
10542 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
10543 & "Eval",waga_theta,eval,
10544 & "Erot",waga_d,Erot
10545 write (iout,*) "ehomology_constr",ehomology_constr
10549 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
10550 747 format(a12,i4,i4,i4,f8.3,f8.3)
10551 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
10552 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
10553 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
10554 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)