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.GEO'
1108 include 'COMMON.VAR'
1109 include 'COMMON.LOCAL'
1110 include 'COMMON.CHAIN'
1111 include 'COMMON.DERIV'
1112 include 'COMMON.NAMES'
1113 include 'COMMON.INTERACT'
1114 include 'COMMON.IOUNITS'
1115 include 'COMMON.CALC'
1116 include 'COMMON.SBRIDGE'
1119 integer icant,xshift,yshift,zshift
1123 c eneps_temp(j,i)=0.0d0
1126 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1130 c if (icall.gt.0) lprn=.true.
1132 do i=iatsc_s,iatsc_e
1133 itypi=iabs(itype(i))
1134 if (itypi.eq.ntyp1) cycle
1135 itypi1=iabs(itype(i+1))
1139 C returning the ith atom to box
1140 call to_box(xi,yi,zi)
1141 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1142 dxi=dc_norm(1,nres+i)
1143 dyi=dc_norm(2,nres+i)
1144 dzi=dc_norm(3,nres+i)
1145 dsci_inv=vbld_inv(i+nres)
1147 C Calculate SC interaction energy.
1149 do iint=1,nint_gr(i)
1150 do j=istart(i,iint),iend(i,iint)
1151 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1152 call dyn_ssbond_ene(i,j,evdwij)
1154 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1155 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1156 C triple bond artifac removal
1157 do k=j+1,iend(i,iint)
1158 C search over all next residues
1159 if (dyn_ss_mask(k)) then
1160 C check if they are cysteins
1161 C write(iout,*) 'k=',k
1162 call triple_ssbond_ene(i,j,k,evdwij)
1163 C call the energy function that removes the artifical triple disulfide
1164 C bond the soubroutine is located in ssMD.F
1166 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1167 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1168 endif!dyn_ss_mask(k)
1172 itypj=iabs(itype(j))
1173 if (itypj.eq.ntyp1) cycle
1174 dscj_inv=vbld_inv(j+nres)
1175 sig0ij=sigma(itypi,itypj)
1176 chi1=chi(itypi,itypj)
1177 chi2=chi(itypj,itypi)
1184 alf12=0.5D0*(alf1+alf2)
1185 C For diagnostics only!!!
1198 C returning jth atom to box
1199 call to_box(xj,yj,zj)
1200 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1201 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1202 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1203 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1204 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1205 xj=boxshift(xj-xi,boxxsize)
1206 yj=boxshift(yj-yi,boxysize)
1207 zj=boxshift(zj-zi,boxzsize)
1208 dxj=dc_norm(1,nres+j)
1209 dyj=dc_norm(2,nres+j)
1210 dzj=dc_norm(3,nres+j)
1211 c write (iout,*) i,j,xj,yj,zj
1212 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1214 sss=sscale(1.0d0/rij)
1215 sssgrad=sscagrad(1.0d0/rij)
1216 if (sss.le.0.0) cycle
1217 C Calculate angle-dependent terms of energy and contributions to their
1222 sig=sig0ij*dsqrt(sigsq)
1223 rij_shift=1.0D0/rij-sig+sig0ij
1224 C I hate to put IF's in the loops, but here don't have another choice!!!!
1225 if (rij_shift.le.0.0D0) then
1230 c---------------------------------------------------------------
1231 rij_shift=1.0D0/rij_shift
1232 fac=rij_shift**expon
1235 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1236 eps2der=evdwij*eps3rt
1237 eps3der=evdwij*eps2rt
1238 evdwij=evdwij*eps2rt*eps3rt
1240 evdw=evdw+evdwij*sss
1242 evdw_t=evdw_t+evdwij*sss
1244 ij=icant(itypi,itypj)
1245 aux=eps1*eps2rt**2*eps3rt**2
1246 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1247 c & /dabs(eps(itypi,itypj))
1248 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1249 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1250 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1251 c & aux*e2/eps(itypi,itypj)
1253 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1257 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1258 & restyp(itypi),i,restyp(itypj),j,
1259 & epsi,sigm,chi1,chi2,chip1,chip2,
1260 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1261 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1263 write (iout,*) "partial sum", evdw, evdw_t
1268 C Calculate gradient components.
1269 e1=e1*eps1*eps2rt**2*eps3rt**2
1270 fac=-expon*(e1+evdwij)*rij_shift
1273 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1274 C Calculate the radial part of the gradient
1278 C Calculate angular part of the gradient.
1281 C write(iout,*) "partial sum", evdw, evdw_t
1288 C-----------------------------------------------------------------------------
1289 subroutine egbv(evdw,evdw_t)
1291 C This subroutine calculates the interaction energy of nonbonded side chains
1292 C assuming the Gay-Berne-Vorobjev potential of interaction.
1294 implicit real*8 (a-h,o-z)
1295 include 'DIMENSIONS'
1296 include "DIMENSIONS.COMPAR"
1297 include 'COMMON.GEO'
1298 include 'COMMON.VAR'
1299 include 'COMMON.LOCAL'
1300 include 'COMMON.CHAIN'
1301 include 'COMMON.DERIV'
1302 include 'COMMON.NAMES'
1303 include 'COMMON.INTERACT'
1304 include 'COMMON.IOUNITS'
1305 include 'COMMON.CALC'
1306 common /srutu/ icall
1312 c eneps_temp(j,i)=0.0d0
1317 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1320 c if (icall.gt.0) lprn=.true.
1322 do i=iatsc_s,iatsc_e
1323 itypi=iabs(itype(i))
1324 if (itypi.eq.ntyp1) cycle
1325 itypi1=iabs(itype(i+1))
1329 call to_box(xi,yi,zi)
1330 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1331 dxi=dc_norm(1,nres+i)
1332 dyi=dc_norm(2,nres+i)
1333 dzi=dc_norm(3,nres+i)
1334 dsci_inv=vbld_inv(i+nres)
1336 C Calculate SC interaction energy.
1338 do iint=1,nint_gr(i)
1339 do j=istart(i,iint),iend(i,iint)
1341 itypj=iabs(itype(j))
1342 if (itypj.eq.ntyp1) cycle
1343 dscj_inv=vbld_inv(j+nres)
1344 sig0ij=sigma(itypi,itypj)
1345 r0ij=r0(itypi,itypj)
1346 chi1=chi(itypi,itypj)
1347 chi2=chi(itypj,itypi)
1354 alf12=0.5D0*(alf1+alf2)
1355 C For diagnostics only!!!
1368 call to_box(xj,yj,zj)
1369 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1370 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1371 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1372 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1373 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1374 dxj=dc_norm(1,nres+j)
1375 dyj=dc_norm(2,nres+j)
1376 dzj=dc_norm(3,nres+j)
1377 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1379 sss=sscale(1.0d0/rij)
1380 if (sss.eq.0.0d0) cycle
1381 sssgrad=sscagrad(1.0d0/rij)
1382 C Calculate angle-dependent terms of energy and contributions to their
1386 sig=sig0ij*dsqrt(sigsq)
1387 rij_shift=1.0D0/rij-sig+r0ij
1388 C I hate to put IF's in the loops, but here don't have another choice!!!!
1389 if (rij_shift.le.0.0D0) then
1394 c---------------------------------------------------------------
1395 rij_shift=1.0D0/rij_shift
1396 fac=rij_shift**expon
1399 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1400 eps2der=evdwij*eps3rt
1401 eps3der=evdwij*eps2rt
1402 fac_augm=rrij**expon
1403 e_augm=augm(itypi,itypj)*fac_augm
1404 evdwij=evdwij*eps2rt*eps3rt
1405 if (bb.gt.0.0d0) then
1406 evdw=evdw+(evdwij+e_augm)*sss
1408 evdw_t=evdw_t+(evdwij+e_augm)*sss
1410 ij=icant(itypi,itypj)
1411 aux=eps1*eps2rt**2*eps3rt**2
1412 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1413 c & /dabs(eps(itypi,itypj))
1414 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1415 c eneps_temp(ij)=eneps_temp(ij)
1416 c & +(evdwij+e_augm)/eps(itypi,itypj)
1418 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1419 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1420 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1421 c & restyp(itypi),i,restyp(itypj),j,
1422 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1423 c & chi1,chi2,chip1,chip2,
1424 c & eps1,eps2rt**2,eps3rt**2,
1425 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1429 C Calculate gradient components.
1430 e1=e1*eps1*eps2rt**2*eps3rt**2
1431 fac=-expon*(e1+evdwij)*rij_shift
1433 fac=rij*fac-2*expon*rrij*e_augm
1434 fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
1435 C Calculate the radial part of the gradient
1439 C Calculate angular part of the gradient.
1447 C-----------------------------------------------------------------------------
1448 subroutine sc_angular
1449 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1450 C om12. Called by ebp, egb, and egbv.
1452 include 'COMMON.CALC'
1456 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1457 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1458 om12=dxi*dxj+dyi*dyj+dzi*dzj
1460 C Calculate eps1(om12) and its derivative in om12
1461 faceps1=1.0D0-om12*chiom12
1462 faceps1_inv=1.0D0/faceps1
1463 eps1=dsqrt(faceps1_inv)
1464 C Following variable is eps1*deps1/dom12
1465 eps1_om12=faceps1_inv*chiom12
1466 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1471 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1472 sigsq=1.0D0-facsig*faceps1_inv
1473 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1474 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1475 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1476 C Calculate eps2 and its derivatives in om1, om2, and om12.
1479 chipom12=chip12*om12
1480 facp=1.0D0-om12*chipom12
1482 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1483 C Following variable is the square root of eps2
1484 eps2rt=1.0D0-facp1*facp_inv
1485 C Following three variables are the derivatives of the square root of eps
1486 C in om1, om2, and om12.
1487 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1488 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1489 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1490 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1491 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1492 C Calculate whole angle-dependent part of epsilon and contributions
1493 C to its derivatives
1496 C----------------------------------------------------------------------------
1498 implicit real*8 (a-h,o-z)
1499 include 'DIMENSIONS'
1500 include 'COMMON.CHAIN'
1501 include 'COMMON.DERIV'
1502 include 'COMMON.CALC'
1503 double precision dcosom1(3),dcosom2(3)
1504 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1505 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1506 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1507 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1509 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1510 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1513 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1516 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1517 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1518 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1519 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1520 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1521 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1524 C Calculate the components of the gradient in DC and X
1528 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1533 c------------------------------------------------------------------------------
1534 subroutine vec_and_deriv
1535 implicit real*8 (a-h,o-z)
1536 include 'DIMENSIONS'
1537 include 'COMMON.IOUNITS'
1538 include 'COMMON.GEO'
1539 include 'COMMON.VAR'
1540 include 'COMMON.LOCAL'
1541 include 'COMMON.CHAIN'
1542 include 'COMMON.VECTORS'
1543 include 'COMMON.DERIV'
1544 include 'COMMON.INTERACT'
1545 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1546 C Compute the local reference systems. For reference system (i), the
1547 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1548 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1550 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1551 if (i.eq.nres-1) then
1552 C Case of the last full residue
1553 C Compute the Z-axis
1554 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1555 costh=dcos(pi-theta(nres))
1556 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1557 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1563 C Compute the derivatives of uz
1565 uzder(2,1,1)=-dc_norm(3,i-1)
1566 uzder(3,1,1)= dc_norm(2,i-1)
1567 uzder(1,2,1)= dc_norm(3,i-1)
1569 uzder(3,2,1)=-dc_norm(1,i-1)
1570 uzder(1,3,1)=-dc_norm(2,i-1)
1571 uzder(2,3,1)= dc_norm(1,i-1)
1574 uzder(2,1,2)= dc_norm(3,i)
1575 uzder(3,1,2)=-dc_norm(2,i)
1576 uzder(1,2,2)=-dc_norm(3,i)
1578 uzder(3,2,2)= dc_norm(1,i)
1579 uzder(1,3,2)= dc_norm(2,i)
1580 uzder(2,3,2)=-dc_norm(1,i)
1583 C Compute the Y-axis
1586 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1589 C Compute the derivatives of uy
1592 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1593 & -dc_norm(k,i)*dc_norm(j,i-1)
1594 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1596 uyder(j,j,1)=uyder(j,j,1)-costh
1597 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1602 uygrad(l,k,j,i)=uyder(l,k,j)
1603 uzgrad(l,k,j,i)=uzder(l,k,j)
1607 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1608 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1609 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1610 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1614 C Compute the Z-axis
1615 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1616 costh=dcos(pi-theta(i+2))
1617 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1622 C Compute the derivatives of uz
1624 uzder(2,1,1)=-dc_norm(3,i+1)
1625 uzder(3,1,1)= dc_norm(2,i+1)
1626 uzder(1,2,1)= dc_norm(3,i+1)
1628 uzder(3,2,1)=-dc_norm(1,i+1)
1629 uzder(1,3,1)=-dc_norm(2,i+1)
1630 uzder(2,3,1)= dc_norm(1,i+1)
1633 uzder(2,1,2)= dc_norm(3,i)
1634 uzder(3,1,2)=-dc_norm(2,i)
1635 uzder(1,2,2)=-dc_norm(3,i)
1637 uzder(3,2,2)= dc_norm(1,i)
1638 uzder(1,3,2)= dc_norm(2,i)
1639 uzder(2,3,2)=-dc_norm(1,i)
1642 C Compute the Y-axis
1645 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1648 C Compute the derivatives of uy
1651 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1652 & -dc_norm(k,i)*dc_norm(j,i+1)
1653 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1655 uyder(j,j,1)=uyder(j,j,1)-costh
1656 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1661 uygrad(l,k,j,i)=uyder(l,k,j)
1662 uzgrad(l,k,j,i)=uzder(l,k,j)
1666 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1667 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1668 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1669 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1675 vbld_inv_temp(1)=vbld_inv(i+1)
1676 if (i.lt.nres-1) then
1677 vbld_inv_temp(2)=vbld_inv(i+2)
1679 vbld_inv_temp(2)=vbld_inv(i)
1684 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1685 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1693 C--------------------------------------------------------------------------
1694 subroutine set_matrices
1695 implicit real*8 (a-h,o-z)
1696 include 'DIMENSIONS'
1700 integer status(MPI_STATUS_SIZE)
1702 include 'COMMON.IOUNITS'
1703 include 'COMMON.GEO'
1704 include 'COMMON.VAR'
1705 include 'COMMON.LOCAL'
1706 include 'COMMON.CHAIN'
1707 include 'COMMON.DERIV'
1708 include 'COMMON.INTERACT'
1709 include 'COMMON.CONTACTS'
1710 include 'COMMON.TORSION'
1711 include 'COMMON.VECTORS'
1712 include 'COMMON.FFIELD'
1713 include 'COMMON.CORRMAT'
1714 double precision auxvec(2),auxmat(2,2)
1716 C Compute the virtual-bond-torsional-angle dependent quantities needed
1717 C to calculate the el-loc multibody terms of various order.
1719 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1723 innt=chain_border(1,ii)
1724 inct=chain_border(2,ii)
1725 if (i.gt. innt+2 .and. i.lt.inct+2) then
1726 iti = itype2loc(itype(i-2))
1730 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1731 if (i.gt. innt+1 .and. i.lt.inct+1) then
1732 iti1 = itype2loc(itype(i-1))
1737 cost1=dcos(theta(i-1))
1738 sint1=dsin(theta(i-1))
1740 sint1cub=sint1sq*sint1
1741 sint1cost1=2*sint1*cost1
1743 write (iout,*) "bnew1",i,iti
1744 write (iout,*) (bnew1(k,1,iti),k=1,3)
1745 write (iout,*) (bnew1(k,2,iti),k=1,3)
1746 write (iout,*) "bnew2",i,iti
1747 write (iout,*) (bnew2(k,1,iti),k=1,3)
1748 write (iout,*) (bnew2(k,2,iti),k=1,3)
1751 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1753 gtb1(k,i-2)=cost1*b1k-sint1sq*
1754 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1755 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1757 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1758 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1761 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1762 cc(1,k,i-2)=sint1sq*aux
1763 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1764 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1765 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1766 dd(1,k,i-2)=sint1sq*aux
1767 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1768 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1770 cc(2,1,i-2)=cc(1,2,i-2)
1771 cc(2,2,i-2)=-cc(1,1,i-2)
1772 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1773 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1774 dd(2,1,i-2)=dd(1,2,i-2)
1775 dd(2,2,i-2)=-dd(1,1,i-2)
1776 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1777 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1780 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1781 EE(l,k,i-2)=sint1sq*aux
1783 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1786 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1787 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1788 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1789 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1791 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1792 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1793 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1795 c b1tilde(1,i-2)=b1(1,i-2)
1796 c b1tilde(2,i-2)=-b1(2,i-2)
1797 c b2tilde(1,i-2)=b2(1,i-2)
1798 c b2tilde(2,i-2)=-b2(2,i-2)
1800 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1801 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1802 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1803 write (iout,*) 'theta=', theta(i-1)
1806 if (i.gt. innt+2 .and. i.lt.inct+2) then
1807 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1808 iti = itype2loc(itype(i-2))
1812 c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
1813 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1814 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1815 iti1 = itype2loc(itype(i-1))
1819 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1820 c iti = itype2loc(itype(i-2))
1824 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1825 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1826 c iti1 = itype2loc(itype(i-1))
1836 CC(k,l,i-2)=ccold(k,l,iti)
1837 DD(k,l,i-2)=ddold(k,l,iti)
1838 EE(k,l,i-2)=eeold(k,l,iti)
1842 b1tilde(1,i-2)= b1(1,i-2)
1843 b1tilde(2,i-2)=-b1(2,i-2)
1844 b2tilde(1,i-2)= b2(1,i-2)
1845 b2tilde(2,i-2)=-b2(2,i-2)
1847 Ctilde(1,1,i-2)= CC(1,1,i-2)
1848 Ctilde(1,2,i-2)= CC(1,2,i-2)
1849 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1850 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1852 Dtilde(1,1,i-2)= DD(1,1,i-2)
1853 Dtilde(1,2,i-2)= DD(1,2,i-2)
1854 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1855 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1856 c write(iout,*) "i",i," iti",iti
1857 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1858 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1861 if (i .lt. nres+1) then
1898 if (i .gt. 3 .and. i .lt. nres+1) then
1899 obrot_der(1,i-2)=-sin1
1900 obrot_der(2,i-2)= cos1
1901 Ugder(1,1,i-2)= sin1
1902 Ugder(1,2,i-2)=-cos1
1903 Ugder(2,1,i-2)=-cos1
1904 Ugder(2,2,i-2)=-sin1
1907 obrot2_der(1,i-2)=-dwasin2
1908 obrot2_der(2,i-2)= dwacos2
1909 Ug2der(1,1,i-2)= dwasin2
1910 Ug2der(1,2,i-2)=-dwacos2
1911 Ug2der(2,1,i-2)=-dwacos2
1912 Ug2der(2,2,i-2)=-dwasin2
1914 obrot_der(1,i-2)=0.0d0
1915 obrot_der(2,i-2)=0.0d0
1916 Ugder(1,1,i-2)=0.0d0
1917 Ugder(1,2,i-2)=0.0d0
1918 Ugder(2,1,i-2)=0.0d0
1919 Ugder(2,2,i-2)=0.0d0
1920 obrot2_der(1,i-2)=0.0d0
1921 obrot2_der(2,i-2)=0.0d0
1922 Ug2der(1,1,i-2)=0.0d0
1923 Ug2der(1,2,i-2)=0.0d0
1924 Ug2der(2,1,i-2)=0.0d0
1925 Ug2der(2,2,i-2)=0.0d0
1927 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1928 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1929 iti = itype2loc(itype(i-2))
1933 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1934 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1935 iti1 = itype2loc(itype(i-1))
1939 cd write (iout,*) '*******i',i,' iti1',iti
1940 cd write (iout,*) 'b1',b1(:,iti)
1941 cd write (iout,*) 'b2',b2(:,iti)
1942 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1943 c if (i .gt. iatel_s+2) then
1944 if (i .gt. nnt+2) then
1945 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1947 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1948 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1950 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1951 c & EE(1,2,iti),EE(2,2,i)
1952 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1953 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1954 c write(iout,*) "Macierz EUG",
1955 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
1958 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
1960 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
1961 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
1962 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1963 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
1964 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
1976 DtUg2(l,k,i-2)=0.0d0
1980 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
1981 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
1983 muder(k,i-2)=Ub2der(k,i-2)
1985 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1986 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1987 if (itype(i-1).le.ntyp) then
1988 iti1 = itype2loc(itype(i-1))
1996 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
1999 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2000 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2001 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2002 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2003 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2004 & ((ee(l,k,i-2),l=1,2),k=1,2)
2006 cd write (iout,*) 'mu1',mu1(:,i-2)
2007 cd write (iout,*) 'mu2',mu2(:,i-2)
2009 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2012 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2013 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2014 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2015 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2016 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2018 C Vectors and matrices dependent on a single virtual-bond dihedral.
2019 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2020 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2021 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2022 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2023 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2025 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2026 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2027 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2028 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2034 C Matrices dependent on two consecutive virtual-bond dihedrals.
2035 C The order of matrices is from left to right.
2036 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2039 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2041 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2042 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2044 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2045 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2047 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2048 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2049 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2056 C--------------------------------------------------------------------------
2057 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2059 C This subroutine calculates the average interaction energy and its gradient
2060 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2061 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2062 C The potential depends both on the distance of peptide-group centers and on
2063 C the orientation of the CA-CA virtual bonds.
2065 implicit real*8 (a-h,o-z)
2069 include 'DIMENSIONS'
2070 include 'COMMON.CONTROL'
2071 include 'COMMON.IOUNITS'
2072 include 'COMMON.GEO'
2073 include 'COMMON.VAR'
2074 include 'COMMON.LOCAL'
2075 include 'COMMON.CHAIN'
2076 include 'COMMON.DERIV'
2077 include 'COMMON.INTERACT'
2079 include 'COMMON.CONTACTS'
2080 include 'COMMON.CONTMAT'
2082 include 'COMMON.CORRMAT'
2083 include 'COMMON.TORSION'
2084 include 'COMMON.VECTORS'
2085 include 'COMMON.FFIELD'
2086 include 'COMMON.TIME1'
2087 include 'COMMON.SPLITELE'
2088 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2089 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2090 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2091 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2092 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2093 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2095 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2097 double precision scal_el /1.0d0/
2099 double precision scal_el /0.5d0/
2102 C 13-go grudnia roku pamietnego...
2103 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2104 & 0.0d0,1.0d0,0.0d0,
2105 & 0.0d0,0.0d0,1.0d0/
2106 cd write(iout,*) 'In EELEC'
2108 cd write(iout,*) 'Type',i
2109 cd write(iout,*) 'B1',B1(:,i)
2110 cd write(iout,*) 'B2',B2(:,i)
2111 cd write(iout,*) 'CC',CC(:,:,i)
2112 cd write(iout,*) 'DD',DD(:,:,i)
2113 cd write(iout,*) 'EE',EE(:,:,i)
2115 cd call check_vecgrad
2117 if (icheckgrad.eq.1) then
2119 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2121 dc_norm(k,i)=dc(k,i)*fac
2123 c write (iout,*) 'i',i,' fac',fac
2126 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2127 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2128 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2129 c call vec_and_deriv
2135 time_mat=time_mat+MPI_Wtime()-time01
2139 cd write (iout,*) 'i=',i
2141 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2144 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2145 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2160 cd print '(a)','Enter EELEC'
2161 c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2164 gel_loc_loc(i)=0.0d0
2169 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2171 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2173 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2174 do i=iturn3_start,iturn3_end
2176 C write(iout,*) "tu jest i",i
2177 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2178 C changes suggested by Ana to avoid out of bounds
2179 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2180 c & .or.((i+4).gt.nres)
2181 c & .or.((i-1).le.0)
2182 C end of changes by Ana
2183 C dobra zmiana wycofana
2184 & .or. itype(i+2).eq.ntyp1
2185 & .or. itype(i+3).eq.ntyp1) cycle
2186 C Adam: Instructions below will switch off existing interactions
2188 c if(itype(i-1).eq.ntyp1)cycle
2190 c if(i.LT.nres-3)then
2191 c if (itype(i+4).eq.ntyp1) cycle
2196 dx_normi=dc_norm(1,i)
2197 dy_normi=dc_norm(2,i)
2198 dz_normi=dc_norm(3,i)
2199 xmedi=c(1,i)+0.5d0*dxi
2200 ymedi=c(2,i)+0.5d0*dyi
2201 zmedi=c(3,i)+0.5d0*dzi
2202 call to_box(xmedi,ymedi,zmedi)
2204 call eelecij(i,i+2,ees,evdw1,eel_loc)
2205 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2207 num_cont_hb(i)=num_conti
2210 do i=iturn4_start,iturn4_end
2212 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2213 C changes suggested by Ana to avoid out of bounds
2214 c & .or.((i+5).gt.nres)
2215 c & .or.((i-1).le.0)
2216 C end of changes suggested by Ana
2217 & .or. itype(i+3).eq.ntyp1
2218 & .or. itype(i+4).eq.ntyp1
2219 c & .or. itype(i+5).eq.ntyp1
2220 c & .or. itype(i).eq.ntyp1
2221 c & .or. itype(i-1).eq.ntyp1
2226 dx_normi=dc_norm(1,i)
2227 dy_normi=dc_norm(2,i)
2228 dz_normi=dc_norm(3,i)
2229 xmedi=c(1,i)+0.5d0*dxi
2230 ymedi=c(2,i)+0.5d0*dyi
2231 zmedi=c(3,i)+0.5d0*dzi
2232 call to_box(xmedi,ymedi,zmedi)
2234 num_conti=num_cont_hb(i)
2236 c write(iout,*) "JESTEM W PETLI"
2237 call eelecij(i,i+3,ees,evdw1,eel_loc)
2238 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2239 & call eturn4(i,eello_turn4)
2241 num_cont_hb(i)=num_conti
2244 C Loop over all neighbouring boxes
2249 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2252 do i=iatel_s,iatel_e
2255 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2256 C changes suggested by Ana to avoid out of bounds
2257 c & .or.((i+2).gt.nres)
2258 c & .or.((i-1).le.0)
2259 C end of changes by Ana
2260 c & .or. itype(i+2).eq.ntyp1
2261 c & .or. itype(i-1).eq.ntyp1
2266 dx_normi=dc_norm(1,i)
2267 dy_normi=dc_norm(2,i)
2268 dz_normi=dc_norm(3,i)
2269 xmedi=c(1,i)+0.5d0*dxi
2270 ymedi=c(2,i)+0.5d0*dyi
2271 zmedi=c(3,i)+0.5d0*dzi
2272 call to_box(xmedi,ymedi,zmedi)
2274 num_conti=num_cont_hb(i)
2277 do j=ielstart(i),ielend(i)
2279 C write (iout,*) i,j
2281 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2282 C changes suggested by Ana to avoid out of bounds
2283 c & .or.((j+2).gt.nres)
2284 c & .or.((j-1).le.0)
2285 C end of changes by Ana
2286 c & .or.itype(j+2).eq.ntyp1
2287 c & .or.itype(j-1).eq.ntyp1
2289 call eelecij(i,j,ees,evdw1,eel_loc)
2292 num_cont_hb(i)=num_conti
2299 c write (iout,*) "Number of loop steps in EELEC:",ind
2301 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2302 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2304 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2305 ccc eel_loc=eel_loc+eello_turn3
2306 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2309 C-------------------------------------------------------------------------------
2310 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2311 implicit real*8 (a-h,o-z)
2312 include 'DIMENSIONS'
2316 include 'COMMON.CONTROL'
2317 include 'COMMON.IOUNITS'
2318 include 'COMMON.GEO'
2319 include 'COMMON.VAR'
2320 include 'COMMON.LOCAL'
2321 include 'COMMON.CHAIN'
2322 include 'COMMON.DERIV'
2323 include 'COMMON.INTERACT'
2325 include 'COMMON.CONTACTS'
2326 include 'COMMON.CONTMAT'
2328 include 'COMMON.CORRMAT'
2329 include 'COMMON.TORSION'
2330 include 'COMMON.VECTORS'
2331 include 'COMMON.FFIELD'
2332 include 'COMMON.TIME1'
2333 include 'COMMON.SPLITELE'
2334 include 'COMMON.SHIELD'
2335 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2336 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2337 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2338 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2339 & gmuij2(4),gmuji2(4)
2340 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2341 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2343 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2345 double precision scal_el /1.0d0/
2347 double precision scal_el /0.5d0/
2350 C 13-go grudnia roku pamietnego...
2351 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2352 & 0.0d0,1.0d0,0.0d0,
2353 & 0.0d0,0.0d0,1.0d0/
2354 integer xshift,yshift,zshift
2355 c time00=MPI_Wtime()
2356 cd write (iout,*) "eelecij",i,j
2360 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2361 aaa=app(iteli,itelj)
2362 bbb=bpp(iteli,itelj)
2363 ael6i=ael6(iteli,itelj)
2364 ael3i=ael3(iteli,itelj)
2368 dx_normj=dc_norm(1,j)
2369 dy_normj=dc_norm(2,j)
2370 dz_normj=dc_norm(3,j)
2371 C xj=c(1,j)+0.5D0*dxj-xmedi
2372 C yj=c(2,j)+0.5D0*dyj-ymedi
2373 C zj=c(3,j)+0.5D0*dzj-zmedi
2377 call to_box(xj,yj,zj)
2378 xj=boxshift(xj-xmedi,boxxsize)
2379 yj=boxshift(yj-ymedi,boxysize)
2380 zj=boxshift(zj-zmedi,boxzsize)
2381 rij=xj*xj+yj*yj+zj*zj
2382 sss=sscale(sqrt(rij))
2383 if (sss.eq.0.0d0) return
2384 sssgrad=sscagrad(sqrt(rij))
2385 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2386 c & " rlamb",rlamb," sss",sss
2387 c if (sss.gt.0.0d0) then
2393 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2394 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2395 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2396 fac=cosa-3.0D0*cosb*cosg
2398 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2399 if (j.eq.i+2) ev1=scal_el*ev1
2404 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2408 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2409 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2410 if (shield_mode.gt.0) then
2413 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2414 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2423 evdw1=evdw1+evdwij*sss
2424 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2425 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2426 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2427 cd & xmedi,ymedi,zmedi,xj,yj,zj
2429 if (energy_dec) then
2430 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2432 &,iteli,itelj,aaa,evdw1,sss
2433 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2434 &fac_shield(i),fac_shield(j)
2438 C Calculate contributions to the Cartesian gradient.
2441 facvdw=-6*rrmij*(ev1+evdwij)*sss
2442 facel=-3*rrmij*(el1+eesij)
2449 * Radial derivatives. First process both termini of the fragment (i,j)
2455 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2456 & (shield_mode.gt.0)) then
2458 do ilist=1,ishield_list(i)
2459 iresshield=shield_list(ilist,i)
2461 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2463 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2465 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2466 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2467 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2468 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2469 C if (iresshield.gt.i) then
2470 C do ishi=i+1,iresshield-1
2471 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2472 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2476 C do ishi=iresshield,i
2477 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2478 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2484 do ilist=1,ishield_list(j)
2485 iresshield=shield_list(ilist,j)
2487 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2489 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2491 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2492 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2494 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2495 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2496 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2497 C if (iresshield.gt.j) then
2498 C do ishi=j+1,iresshield-1
2499 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2500 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2504 C do ishi=iresshield,j
2505 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2506 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2513 gshieldc(k,i)=gshieldc(k,i)+
2514 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2515 gshieldc(k,j)=gshieldc(k,j)+
2516 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2517 gshieldc(k,i-1)=gshieldc(k,i-1)+
2518 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2519 gshieldc(k,j-1)=gshieldc(k,j-1)+
2520 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2525 c ghalf=0.5D0*ggg(k)
2526 c gelc(k,i)=gelc(k,i)+ghalf
2527 c gelc(k,j)=gelc(k,j)+ghalf
2529 c 9/28/08 AL Gradient compotents will be summed only at the end
2530 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2532 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2533 C & +grad_shield(k,j)*eesij/fac_shield(j)
2534 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2535 C & +grad_shield(k,i)*eesij/fac_shield(i)
2536 C gelc_long(k,i-1)=gelc_long(k,i-1)
2537 C & +grad_shield(k,i)*eesij/fac_shield(i)
2538 C gelc_long(k,j-1)=gelc_long(k,j-1)
2539 C & +grad_shield(k,j)*eesij/fac_shield(j)
2541 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2544 * Loop over residues i+1 thru j-1.
2548 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2551 if (sss.gt.0.0) then
2552 facvdw=facvdw+sssgrad*rmij*evdwij
2562 c ghalf=0.5D0*ggg(k)
2563 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2564 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2566 c 9/28/08 AL Gradient compotents will be summed only at the end
2568 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2569 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2572 * Loop over residues i+1 thru j-1.
2576 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2585 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2586 & +(evdwij+eesij)*sssgrad*rrmij
2591 * Radial derivatives. First process both termini of the fragment (i,j)
2595 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2597 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2599 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2601 c ghalf=0.5D0*ggg(k)
2602 c gelc(k,i)=gelc(k,i)+ghalf
2603 c gelc(k,j)=gelc(k,j)+ghalf
2605 c 9/28/08 AL Gradient compotents will be summed only at the end
2607 gelc_long(k,j)=gelc(k,j)+ggg(k)
2608 gelc_long(k,i)=gelc(k,i)-ggg(k)
2611 * Loop over residues i+1 thru j-1.
2615 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2618 c 9/28/08 AL Gradient compotents will be summed only at the end
2619 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2620 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2621 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2623 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2624 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2632 ecosa=2.0D0*fac3*fac1+fac4
2635 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2636 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2638 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2639 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2641 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2642 cd & (dcosg(k),k=1,3)
2644 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2645 & fac_shield(i)**2*fac_shield(j)**2
2648 c ghalf=0.5D0*ggg(k)
2649 c gelc(k,i)=gelc(k,i)+ghalf
2650 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2651 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2652 c gelc(k,j)=gelc(k,j)+ghalf
2653 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2654 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2658 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2661 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2664 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2665 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2666 & *fac_shield(i)**2*fac_shield(j)**2
2668 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2669 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2670 & *fac_shield(i)**2*fac_shield(j)**2
2671 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2672 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2674 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2679 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2680 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2681 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2683 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2684 C energy of a peptide unit is assumed in the form of a second-order
2685 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2686 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2687 C are computed for EVERY pair of non-contiguous peptide groups.
2690 if (j.lt.nres-1) then
2702 muij(kkk)=mu(k,i)*mu(l,j)
2703 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2706 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2707 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2708 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2709 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2710 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2711 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2717 write (iout,*) 'EELEC: i',i,' j',j
2718 write (iout,*) 'j',j,' j1',j1,' j2',j2
2719 write(iout,*) 'muij',muij
2720 write (iout,*) "uy",uy(:,i)
2721 write (iout,*) "uz",uz(:,j)
2722 write (iout,*) "erij",erij
2724 ury=scalar(uy(1,i),erij)
2725 urz=scalar(uz(1,i),erij)
2726 vry=scalar(uy(1,j),erij)
2727 vrz=scalar(uz(1,j),erij)
2728 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2729 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2730 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2731 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2732 fac=dsqrt(-ael6i)*r3ij
2737 cd write (iout,'(4i5,4f10.5)')
2738 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2739 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2740 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2741 cd & uy(:,j),uz(:,j)
2742 cd write (iout,'(4f10.5)')
2743 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2744 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2745 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2746 cd write (iout,'(9f10.5/)')
2747 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2748 C Derivatives of the elements of A in virtual-bond vectors
2750 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2752 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2753 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2754 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2755 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2756 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2757 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2758 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2759 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2760 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2761 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2762 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2763 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2765 C Compute radial contributions to the gradient
2783 C Add the contributions coming from er
2786 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2787 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2788 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2789 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2792 C Derivatives in DC(i)
2793 cgrad ghalf1=0.5d0*agg(k,1)
2794 cgrad ghalf2=0.5d0*agg(k,2)
2795 cgrad ghalf3=0.5d0*agg(k,3)
2796 cgrad ghalf4=0.5d0*agg(k,4)
2797 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2798 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2799 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2800 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2801 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2802 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2803 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2804 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2805 C Derivatives in DC(i+1)
2806 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2807 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2808 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2809 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2810 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2811 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2812 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2813 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2814 C Derivatives in DC(j)
2815 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2816 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2817 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2818 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2819 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2820 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2821 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2822 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2823 C Derivatives in DC(j+1) or DC(nres-1)
2824 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2825 & -3.0d0*vryg(k,3)*ury)
2826 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2827 & -3.0d0*vrzg(k,3)*ury)
2828 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2829 & -3.0d0*vryg(k,3)*urz)
2830 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2831 & -3.0d0*vrzg(k,3)*urz)
2832 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2834 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2849 aggi(k,l)=-aggi(k,l)
2850 aggi1(k,l)=-aggi1(k,l)
2851 aggj(k,l)=-aggj(k,l)
2852 aggj1(k,l)=-aggj1(k,l)
2856 if (j.lt.nres-1) then
2862 aggi(k,l)=-aggi(k,l)
2863 aggi1(k,l)=-aggi1(k,l)
2864 aggj(k,l)=-aggj(k,l)
2865 aggj1(k,l)=-aggj1(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)
2884 IF (wel_loc.gt.0.0d0) THEN
2885 C Contribution to the local-electrostatic energy coming from the i-j pair
2886 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2889 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
2891 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
2892 & " wel_loc",wel_loc
2894 if (shield_mode.eq.0) then
2901 eel_loc_ij=eel_loc_ij
2902 & *fac_shield(i)*fac_shield(j)
2903 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2904 & 'eelloc',i,j,eel_loc_ij
2905 c if (eel_loc_ij.ne.0)
2906 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
2907 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
2909 eel_loc=eel_loc+eel_loc_ij*sss
2910 C Now derivative over eel_loc
2912 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2913 & (shield_mode.gt.0)) then
2916 do ilist=1,ishield_list(i)
2917 iresshield=shield_list(ilist,i)
2919 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2922 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2924 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2925 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2929 do ilist=1,ishield_list(j)
2930 iresshield=shield_list(ilist,j)
2932 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2935 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2937 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2938 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2945 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2946 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2947 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2948 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2949 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2950 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2951 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2952 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2957 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
2958 c & ' eel_loc_ij',eel_loc_ij
2959 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2960 C Calculate patrial derivative for theta angle
2962 geel_loc_ij=(a22*gmuij1(1)
2966 & *fac_shield(i)*fac_shield(j)*sss
2967 c write(iout,*) "derivative over thatai"
2968 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
2970 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
2971 & geel_loc_ij*wel_loc
2972 c write(iout,*) "derivative over thatai-1"
2973 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
2980 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
2981 & geel_loc_ij*wel_loc
2982 & *fac_shield(i)*fac_shield(j)*sss
2984 c Derivative over j residue
2985 geel_loc_ji=a22*gmuji1(1)
2989 c write(iout,*) "derivative over thataj"
2990 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
2993 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
2994 & geel_loc_ji*wel_loc
2995 & *fac_shield(i)*fac_shield(j)
3002 c write(iout,*) "derivative over thataj-1"
3003 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3005 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3006 & geel_loc_ji*wel_loc
3007 & *fac_shield(i)*fac_shield(j)*sss
3009 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3011 C Partial derivatives in virtual-bond dihedral angles gamma
3013 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3014 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3015 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3016 & *fac_shield(i)*fac_shield(j)
3018 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3019 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3020 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3021 & *fac_shield(i)*fac_shield(j)
3022 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3023 aux=eel_loc_ij/sss*sssgrad*rmij
3028 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3029 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3030 & *fac_shield(i)*fac_shield(j)*sss
3031 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3032 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3033 cgrad ghalf=0.5d0*ggg(l)
3034 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3035 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3039 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3042 C Remaining derivatives of eello
3044 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3045 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3046 & *fac_shield(i)*fac_shield(j)
3048 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3049 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3050 & *fac_shield(i)*fac_shield(j)
3052 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3053 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3054 & *fac_shield(i)*fac_shield(j)
3056 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3057 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3058 & *fac_shield(i)*fac_shield(j)
3065 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3066 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3068 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3069 & .and. num_conti.le.maxconts) then
3070 c write (iout,*) i,j," entered corr"
3072 C Calculate the contact function. The ith column of the array JCONT will
3073 C contain the numbers of atoms that make contacts with the atom I (of numbers
3074 C greater than I). The arrays FACONT and GACONT will contain the values of
3075 C the contact function and its derivative.
3076 c r0ij=1.02D0*rpp(iteli,itelj)
3077 c r0ij=1.11D0*rpp(iteli,itelj)
3078 r0ij=2.20D0*rpp(iteli,itelj)
3079 c r0ij=1.55D0*rpp(iteli,itelj)
3080 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3081 if (fcont.gt.0.0D0) then
3082 num_conti=num_conti+1
3083 if (num_conti.gt.maxconts) then
3084 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3085 & ' will skip next contacts for this conf.'
3087 jcont_hb(num_conti,i)=j
3088 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3089 cd & " jcont_hb",jcont_hb(num_conti,i)
3090 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3091 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3092 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3094 d_cont(num_conti,i)=rij
3095 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3096 C --- Electrostatic-interaction matrix ---
3097 a_chuj(1,1,num_conti,i)=a22
3098 a_chuj(1,2,num_conti,i)=a23
3099 a_chuj(2,1,num_conti,i)=a32
3100 a_chuj(2,2,num_conti,i)=a33
3101 C --- Gradient of rij
3104 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3111 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3112 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3113 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3114 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3115 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3121 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3122 C Calculate contact energies
3124 wij=cosa-3.0D0*cosb*cosg
3127 c fac3=dsqrt(-ael6i)/r0ij**3
3128 fac3=dsqrt(-ael6i)*r3ij
3129 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3130 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3131 if (ees0tmp.gt.0) then
3132 ees0pij=dsqrt(ees0tmp)
3136 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3137 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3138 if (ees0tmp.gt.0) then
3139 ees0mij=dsqrt(ees0tmp)
3144 if (shield_mode.eq.0) then
3148 ees0plist(num_conti,i)=j
3149 C fac_shield(i)=0.4d0
3150 C fac_shield(j)=0.6d0
3152 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3153 & *fac_shield(i)*fac_shield(j)
3154 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3155 & *fac_shield(i)*fac_shield(j)
3156 C Diagnostics. Comment out or remove after debugging!
3157 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3158 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3159 c ees0m(num_conti,i)=0.0D0
3161 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3162 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3163 C Angular derivatives of the contact function
3165 ees0pij1=fac3/ees0pij
3166 ees0mij1=fac3/ees0mij
3167 fac3p=-3.0D0*fac3*rrmij
3168 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3169 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3171 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3172 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3173 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3174 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3175 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3176 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3177 ecosap=ecosa1+ecosa2
3178 ecosbp=ecosb1+ecosb2
3179 ecosgp=ecosg1+ecosg2
3180 ecosam=ecosa1-ecosa2
3181 ecosbm=ecosb1-ecosb2
3182 ecosgm=ecosg1-ecosg2
3191 facont_hb(num_conti,i)=fcont
3194 fprimcont=fprimcont/rij
3195 cd facont_hb(num_conti,i)=1.0D0
3196 C Following line is for diagnostics.
3199 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3200 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3203 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3204 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3206 gggp(1)=gggp(1)+ees0pijp*xj
3207 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3208 gggp(2)=gggp(2)+ees0pijp*yj
3209 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3210 gggp(3)=gggp(3)+ees0pijp*zj
3211 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3212 gggm(1)=gggm(1)+ees0mijp*xj
3213 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3214 gggm(2)=gggm(2)+ees0mijp*yj
3215 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3216 gggm(3)=gggm(3)+ees0mijp*zj
3217 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3218 C Derivatives due to the contact function
3219 gacont_hbr(1,num_conti,i)=fprimcont*xj
3220 gacont_hbr(2,num_conti,i)=fprimcont*yj
3221 gacont_hbr(3,num_conti,i)=fprimcont*zj
3224 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3225 c following the change of gradient-summation algorithm.
3227 cgrad ghalfp=0.5D0*gggp(k)
3228 cgrad ghalfm=0.5D0*gggm(k)
3229 gacontp_hb1(k,num_conti,i)=!ghalfp
3230 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3231 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3232 & *fac_shield(i)*fac_shield(j)*sss
3234 gacontp_hb2(k,num_conti,i)=!ghalfp
3235 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3236 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3237 & *fac_shield(i)*fac_shield(j)*sss
3239 gacontp_hb3(k,num_conti,i)=gggp(k)
3240 & *fac_shield(i)*fac_shield(j)*sss
3242 gacontm_hb1(k,num_conti,i)=!ghalfm
3243 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3244 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3245 & *fac_shield(i)*fac_shield(j)*sss
3247 gacontm_hb2(k,num_conti,i)=!ghalfm
3248 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3249 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3250 & *fac_shield(i)*fac_shield(j)*sss
3252 gacontm_hb3(k,num_conti,i)=gggm(k)
3253 & *fac_shield(i)*fac_shield(j)
3256 C Diagnostics. Comment out or remove after debugging!
3258 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3259 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3260 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3261 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3262 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3263 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3269 endif ! num_conti.le.maxconts
3274 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3277 ghalf=0.5d0*agg(l,k)
3278 aggi(l,k)=aggi(l,k)+ghalf
3279 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3280 aggj(l,k)=aggj(l,k)+ghalf
3283 if (j.eq.nres-1 .and. i.lt.j-2) then
3286 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3292 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3295 C-----------------------------------------------------------------------------
3296 subroutine eturn3(i,eello_turn3)
3297 C Third- and fourth-order contributions from turns
3298 implicit real*8 (a-h,o-z)
3299 include 'DIMENSIONS'
3300 include 'COMMON.IOUNITS'
3301 include 'COMMON.GEO'
3302 include 'COMMON.VAR'
3303 include 'COMMON.LOCAL'
3304 include 'COMMON.CHAIN'
3305 include 'COMMON.DERIV'
3306 include 'COMMON.INTERACT'
3307 include 'COMMON.CORRMAT'
3308 include 'COMMON.TORSION'
3309 include 'COMMON.VECTORS'
3310 include 'COMMON.FFIELD'
3311 include 'COMMON.CONTROL'
3312 include 'COMMON.SHIELD'
3314 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3315 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3316 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3317 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3318 & auxgmat2(2,2),auxgmatt2(2,2)
3319 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3320 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3321 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3322 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3325 c write (iout,*) "eturn3",i,j,j1,j2
3330 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3332 C Third-order contributions
3339 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3340 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3341 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3342 c auxalary matices for theta gradient
3343 c auxalary matrix for i+1 and constant i+2
3344 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3345 c auxalary matrix for i+2 and constant i+1
3346 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3347 call transpose2(auxmat(1,1),auxmat1(1,1))
3348 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3349 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3350 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3351 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3352 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3353 if (shield_mode.eq.0) then
3360 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3361 & *fac_shield(i)*fac_shield(j)
3362 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3363 & *fac_shield(i)*fac_shield(j)
3364 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3368 C Derivatives in theta
3369 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3370 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3371 & *fac_shield(i)*fac_shield(j)
3372 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3373 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3374 & *fac_shield(i)*fac_shield(j)
3377 C Derivatives in shield mode
3378 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3379 & (shield_mode.gt.0)) then
3382 do ilist=1,ishield_list(i)
3383 iresshield=shield_list(ilist,i)
3385 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3387 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3389 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3390 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3394 do ilist=1,ishield_list(j)
3395 iresshield=shield_list(ilist,j)
3397 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3399 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3401 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3402 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3409 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3410 & grad_shield(k,i)*eello_t3/fac_shield(i)
3411 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3412 & grad_shield(k,j)*eello_t3/fac_shield(j)
3413 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3414 & grad_shield(k,i)*eello_t3/fac_shield(i)
3415 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3416 & grad_shield(k,j)*eello_t3/fac_shield(j)
3420 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3421 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3422 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3423 cd & ' eello_turn3_num',4*eello_turn3_num
3424 C Derivatives in gamma(i)
3425 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3426 call transpose2(auxmat2(1,1),auxmat3(1,1))
3427 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3428 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3429 & *fac_shield(i)*fac_shield(j)
3430 C Derivatives in gamma(i+1)
3431 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3432 call transpose2(auxmat2(1,1),auxmat3(1,1))
3433 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3434 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3435 & +0.5d0*(pizda(1,1)+pizda(2,2))
3436 & *fac_shield(i)*fac_shield(j)
3437 C Cartesian derivatives
3439 c ghalf1=0.5d0*agg(l,1)
3440 c ghalf2=0.5d0*agg(l,2)
3441 c ghalf3=0.5d0*agg(l,3)
3442 c ghalf4=0.5d0*agg(l,4)
3443 a_temp(1,1)=aggi(l,1)!+ghalf1
3444 a_temp(1,2)=aggi(l,2)!+ghalf2
3445 a_temp(2,1)=aggi(l,3)!+ghalf3
3446 a_temp(2,2)=aggi(l,4)!+ghalf4
3447 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3448 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3449 & +0.5d0*(pizda(1,1)+pizda(2,2))
3450 & *fac_shield(i)*fac_shield(j)
3452 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3453 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3454 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3455 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3456 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3457 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3458 & +0.5d0*(pizda(1,1)+pizda(2,2))
3459 & *fac_shield(i)*fac_shield(j)
3460 a_temp(1,1)=aggj(l,1)!+ghalf1
3461 a_temp(1,2)=aggj(l,2)!+ghalf2
3462 a_temp(2,1)=aggj(l,3)!+ghalf3
3463 a_temp(2,2)=aggj(l,4)!+ghalf4
3464 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3465 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3466 & +0.5d0*(pizda(1,1)+pizda(2,2))
3467 & *fac_shield(i)*fac_shield(j)
3468 a_temp(1,1)=aggj1(l,1)
3469 a_temp(1,2)=aggj1(l,2)
3470 a_temp(2,1)=aggj1(l,3)
3471 a_temp(2,2)=aggj1(l,4)
3472 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3473 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3474 & +0.5d0*(pizda(1,1)+pizda(2,2))
3475 & *fac_shield(i)*fac_shield(j)
3482 C-------------------------------------------------------------------------------
3483 subroutine eturn4(i,eello_turn4)
3484 C Third- and fourth-order contributions from turns
3485 implicit real*8 (a-h,o-z)
3486 include 'DIMENSIONS'
3487 include 'COMMON.IOUNITS'
3488 include 'COMMON.GEO'
3489 include 'COMMON.VAR'
3490 include 'COMMON.LOCAL'
3491 include 'COMMON.CHAIN'
3492 include 'COMMON.DERIV'
3493 include 'COMMON.INTERACT'
3494 include 'COMMON.CORRMAT'
3495 include 'COMMON.TORSION'
3496 include 'COMMON.VECTORS'
3497 include 'COMMON.FFIELD'
3498 include 'COMMON.CONTROL'
3499 include 'COMMON.SHIELD'
3501 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3502 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3503 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3504 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3505 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3506 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3507 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3508 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3509 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3510 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3511 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3514 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3516 C Fourth-order contributions
3524 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3525 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3526 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3527 c write(iout,*)"WCHODZE W PROGRAM"
3532 iti1=itype2loc(itype(i+1))
3533 iti2=itype2loc(itype(i+2))
3534 iti3=itype2loc(itype(i+3))
3535 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3536 call transpose2(EUg(1,1,i+1),e1t(1,1))
3537 call transpose2(Eug(1,1,i+2),e2t(1,1))
3538 call transpose2(Eug(1,1,i+3),e3t(1,1))
3539 C Ematrix derivative in theta
3540 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3541 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3542 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3543 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3544 c eta1 in derivative theta
3545 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3546 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3547 c auxgvec is derivative of Ub2 so i+3 theta
3548 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3549 c auxalary matrix of E i+1
3550 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3553 s1=scalar2(b1(1,i+2),auxvec(1))
3554 c derivative of theta i+2 with constant i+3
3555 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3556 c derivative of theta i+2 with constant i+2
3557 gs32=scalar2(b1(1,i+2),auxgvec(1))
3558 c derivative of E matix in theta of i+1
3559 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3561 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3562 c ea31 in derivative theta
3563 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3564 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3565 c auxilary matrix auxgvec of Ub2 with constant E matirx
3566 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3567 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3568 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3572 s2=scalar2(b1(1,i+1),auxvec(1))
3573 c derivative of theta i+1 with constant i+3
3574 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3575 c derivative of theta i+2 with constant i+1
3576 gs21=scalar2(b1(1,i+1),auxgvec(1))
3577 c derivative of theta i+3 with constant i+1
3578 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3579 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3581 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3582 c two derivatives over diffetent matrices
3583 c gtae3e2 is derivative over i+3
3584 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3585 c ae3gte2 is derivative over i+2
3586 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3587 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3588 c three possible derivative over theta E matices
3590 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3592 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3594 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3595 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3597 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3598 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3599 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3600 if (shield_mode.eq.0) then
3607 eello_turn4=eello_turn4-(s1+s2+s3)
3608 & *fac_shield(i)*fac_shield(j)
3609 eello_t4=-(s1+s2+s3)
3610 & *fac_shield(i)*fac_shield(j)
3611 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3612 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3613 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3614 C Now derivative over shield:
3615 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3616 & (shield_mode.gt.0)) then
3619 do ilist=1,ishield_list(i)
3620 iresshield=shield_list(ilist,i)
3622 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3624 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3626 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3627 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3631 do ilist=1,ishield_list(j)
3632 iresshield=shield_list(ilist,j)
3634 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3636 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3638 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3639 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3646 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3647 & grad_shield(k,i)*eello_t4/fac_shield(i)
3648 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3649 & grad_shield(k,j)*eello_t4/fac_shield(j)
3650 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3651 & grad_shield(k,i)*eello_t4/fac_shield(i)
3652 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3653 & grad_shield(k,j)*eello_t4/fac_shield(j)
3656 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3657 cd & ' eello_turn4_num',8*eello_turn4_num
3659 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3660 & -(gs13+gsE13+gsEE1)*wturn4
3661 & *fac_shield(i)*fac_shield(j)
3662 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3663 & -(gs23+gs21+gsEE2)*wturn4
3664 & *fac_shield(i)*fac_shield(j)
3666 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3667 & -(gs32+gsE31+gsEE3)*wturn4
3668 & *fac_shield(i)*fac_shield(j)
3670 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3673 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3674 & 'eturn4',i,j,-(s1+s2+s3)
3675 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3676 c & ' eello_turn4_num',8*eello_turn4_num
3677 C Derivatives in gamma(i)
3678 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3679 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3680 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3681 s1=scalar2(b1(1,i+2),auxvec(1))
3682 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3683 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3684 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3685 & *fac_shield(i)*fac_shield(j)
3686 C Derivatives in gamma(i+1)
3687 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3688 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3689 s2=scalar2(b1(1,i+1),auxvec(1))
3690 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3691 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3692 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3693 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3694 & *fac_shield(i)*fac_shield(j)
3695 C Derivatives in gamma(i+2)
3696 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3697 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3698 s1=scalar2(b1(1,i+2),auxvec(1))
3699 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3700 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3701 s2=scalar2(b1(1,i+1),auxvec(1))
3702 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3703 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3704 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3705 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3706 & *fac_shield(i)*fac_shield(j)
3708 C Cartesian derivatives
3709 C Derivatives of this turn contributions in DC(i+2)
3710 if (j.lt.nres-1) then
3712 a_temp(1,1)=agg(l,1)
3713 a_temp(1,2)=agg(l,2)
3714 a_temp(2,1)=agg(l,3)
3715 a_temp(2,2)=agg(l,4)
3716 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3717 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3718 s1=scalar2(b1(1,i+2),auxvec(1))
3719 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3720 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3721 s2=scalar2(b1(1,i+1),auxvec(1))
3722 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3723 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3724 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3726 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3727 & *fac_shield(i)*fac_shield(j)
3730 C Remaining derivatives of this turn contribution
3732 a_temp(1,1)=aggi(l,1)
3733 a_temp(1,2)=aggi(l,2)
3734 a_temp(2,1)=aggi(l,3)
3735 a_temp(2,2)=aggi(l,4)
3736 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3737 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3738 s1=scalar2(b1(1,i+2),auxvec(1))
3739 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3740 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3741 s2=scalar2(b1(1,i+1),auxvec(1))
3742 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3743 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3744 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3745 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3746 & *fac_shield(i)*fac_shield(j)
3747 a_temp(1,1)=aggi1(l,1)
3748 a_temp(1,2)=aggi1(l,2)
3749 a_temp(2,1)=aggi1(l,3)
3750 a_temp(2,2)=aggi1(l,4)
3751 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3752 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3753 s1=scalar2(b1(1,i+2),auxvec(1))
3754 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3755 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3756 s2=scalar2(b1(1,i+1),auxvec(1))
3757 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3758 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3759 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3760 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3761 & *fac_shield(i)*fac_shield(j)
3762 a_temp(1,1)=aggj(l,1)
3763 a_temp(1,2)=aggj(l,2)
3764 a_temp(2,1)=aggj(l,3)
3765 a_temp(2,2)=aggj(l,4)
3766 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3767 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3768 s1=scalar2(b1(1,i+2),auxvec(1))
3769 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3770 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3771 s2=scalar2(b1(1,i+1),auxvec(1))
3772 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3773 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3774 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3775 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3776 & *fac_shield(i)*fac_shield(j)
3777 a_temp(1,1)=aggj1(l,1)
3778 a_temp(1,2)=aggj1(l,2)
3779 a_temp(2,1)=aggj1(l,3)
3780 a_temp(2,2)=aggj1(l,4)
3781 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3782 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3783 s1=scalar2(b1(1,i+2),auxvec(1))
3784 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3785 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3786 s2=scalar2(b1(1,i+1),auxvec(1))
3787 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3788 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3789 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3790 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3791 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3792 & *fac_shield(i)*fac_shield(j)
3799 C-----------------------------------------------------------------------------
3800 subroutine vecpr(u,v,w)
3801 implicit real*8(a-h,o-z)
3802 dimension u(3),v(3),w(3)
3803 w(1)=u(2)*v(3)-u(3)*v(2)
3804 w(2)=-u(1)*v(3)+u(3)*v(1)
3805 w(3)=u(1)*v(2)-u(2)*v(1)
3808 C-----------------------------------------------------------------------------
3809 subroutine unormderiv(u,ugrad,unorm,ungrad)
3810 C This subroutine computes the derivatives of a normalized vector u, given
3811 C the derivatives computed without normalization conditions, ugrad. Returns
3814 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3815 double precision vec(3)
3816 double precision scalar
3818 c write (2,*) 'ugrad',ugrad
3821 vec(i)=scalar(ugrad(1,i),u(1))
3823 c write (2,*) 'vec',vec
3826 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3829 c write (2,*) 'ungrad',ungrad
3832 C-----------------------------------------------------------------------------
3833 subroutine escp(evdw2,evdw2_14)
3835 C This subroutine calculates the excluded-volume interaction energy between
3836 C peptide-group centers and side chains and its gradient in virtual-bond and
3837 C side-chain vectors.
3839 implicit real*8 (a-h,o-z)
3840 include 'DIMENSIONS'
3841 include 'COMMON.GEO'
3842 include 'COMMON.VAR'
3843 include 'COMMON.LOCAL'
3844 include 'COMMON.CHAIN'
3845 include 'COMMON.DERIV'
3846 include 'COMMON.INTERACT'
3847 include 'COMMON.FFIELD'
3848 include 'COMMON.IOUNITS'
3852 cd print '(a)','Enter ESCP'
3853 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3854 c & ' scal14',scal14
3855 do i=iatscp_s,iatscp_e
3856 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3858 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3859 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3860 if (iteli.eq.0) goto 1225
3861 xi=0.5D0*(c(1,i)+c(1,i+1))
3862 yi=0.5D0*(c(2,i)+c(2,i+1))
3863 zi=0.5D0*(c(3,i)+c(3,i+1))
3864 C Returning the ith atom to box
3865 call to_box(xi,yi,zi)
3866 do iint=1,nscp_gr(i)
3868 do j=iscpstart(i,iint),iscpend(i,iint)
3869 itypj=iabs(itype(j))
3870 if (itypj.eq.ntyp1) cycle
3871 C Uncomment following three lines for SC-p interactions
3875 C Uncomment following three lines for Ca-p interactions
3879 C returning the jth atom to box
3880 call to_box(xj,yj,zj)
3881 xj=boxshift(xj-xi,boxxsize)
3882 yj=boxshift(yj-yi,boxysize)
3883 zj=boxshift(zj-zi,boxzsize)
3884 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3885 C sss is scaling function for smoothing the cutoff gradient otherwise
3886 C the gradient would not be continuouse
3887 sss=sscale(1.0d0/(dsqrt(rrij)))
3888 if (sss.le.0.0d0) cycle
3889 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3891 e1=fac*fac*aad(itypj,iteli)
3892 e2=fac*bad(itypj,iteli)
3893 if (iabs(j-i) .le. 2) then
3896 evdw2_14=evdw2_14+(e1+e2)*sss
3899 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3900 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3901 c & bad(itypj,iteli)
3902 evdw2=evdw2+evdwij*sss
3905 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3907 fac=-(evdwij+e1)*rrij*sss
3908 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3913 cd write (iout,*) 'j<i'
3914 C Uncomment following three lines for SC-p interactions
3916 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3919 cd write (iout,*) 'j>i'
3922 C Uncomment following line for SC-p interactions
3923 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3927 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3931 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3932 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3935 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3945 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3946 gradx_scp(j,i)=expon*gradx_scp(j,i)
3949 C******************************************************************************
3953 C To save time the factor EXPON has been extracted from ALL components
3954 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3957 C******************************************************************************
3960 C--------------------------------------------------------------------------
3961 subroutine edis(ehpb)
3963 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3965 implicit real*8 (a-h,o-z)
3966 include 'DIMENSIONS'
3967 include 'COMMON.SBRIDGE'
3968 include 'COMMON.CHAIN'
3969 include 'COMMON.DERIV'
3970 include 'COMMON.VAR'
3971 include 'COMMON.INTERACT'
3972 include 'COMMON.CONTROL'
3973 include 'COMMON.IOUNITS'
3974 dimension ggg(3),ggg_peak(3,1000)
3977 c 8/21/18 AL: added explicit restraints on reference coords
3978 c write (iout,*) "restr_on_coord",restr_on_coord
3979 if (restr_on_coord) then
3983 if (itype(i).eq.ntyp1) cycle
3985 ecoor=ecoor+(c(j,i)-cref(j,i))**2
3986 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
3988 if (itype(i).ne.10) then
3990 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
3991 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
3994 if (energy_dec) write (iout,*)
3995 & "i",i," bfac",bfac(i)," ecoor",ecoor
3996 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4000 C write (iout,*) ,"link_end",link_end,constr_dist
4001 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4002 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4003 c & " constr_dist",constr_dist
4004 if (link_end.eq.0.and.link_end_peak.eq.0) return
4005 do i=link_start_peak,link_end_peak
4007 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4008 c & ipeak(1,i),ipeak(2,i)
4009 do ip=ipeak(1,i),ipeak(2,i)
4014 C iii and jjj point to the residues for which the distance is assigned.
4015 c if (ii.gt.nres) then
4022 if (ii.gt.nres) then
4027 if (jj.gt.nres) then
4032 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4033 aux=dexp(-scal_peak*aux)
4034 ehpb_peak=ehpb_peak+aux
4035 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4036 & forcon_peak(ip))*aux/dd
4038 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4040 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4041 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4042 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4044 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4045 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4046 do ip=ipeak(1,i),ipeak(2,i)
4049 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4053 C iii and jjj point to the residues for which the distance is assigned.
4054 c if (ii.gt.nres) then
4061 if (ii.gt.nres) then
4066 if (jj.gt.nres) then
4073 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4078 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4082 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4083 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4087 do i=link_start,link_end
4088 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4089 C CA-CA distance used in regularization of structure.
4092 C iii and jjj point to the residues for which the distance is assigned.
4093 c if (ii.gt.nres) then
4100 if (ii.gt.nres) then
4105 if (jj.gt.nres) then
4110 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4111 c & dhpb(i),dhpb1(i),forcon(i)
4112 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4113 C distance and angle dependent SS bond potential.
4114 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4115 C & iabs(itype(jjj)).eq.1) then
4116 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4117 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4118 if (.not.dyn_ss .and. i.le.nss) then
4119 C 15/02/13 CC dynamic SSbond - additional check
4120 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4121 & iabs(itype(jjj)).eq.1) then
4122 call ssbond_ene(iii,jjj,eij)
4125 cd write (iout,*) "eij",eij
4126 cd & ' waga=',waga,' fac=',fac
4127 ! else if (ii.gt.nres .and. jj.gt.nres) then
4129 C Calculate the distance between the two points and its difference from the
4132 if (irestr_type(i).eq.11) then
4133 ehpb=ehpb+fordepth(i)!**4.0d0
4134 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4135 fac=fordepth(i)!**4.0d0
4136 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4137 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4138 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4139 & ehpb,irestr_type(i)
4140 else if (irestr_type(i).eq.10) then
4141 c AL 6//19/2018 cross-link restraints
4142 xdis = 0.5d0*(dd/forcon(i))**2
4143 expdis = dexp(-xdis)
4144 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4145 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4146 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4147 c & " wboltzd",wboltzd
4148 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4149 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4150 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4151 & *expdis/(aux*forcon(i)**2)
4152 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4153 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4154 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4155 else if (irestr_type(i).eq.2) then
4156 c Quartic restraints
4157 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4158 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4159 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4160 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4161 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4163 c Quadratic restraints
4165 C Get the force constant corresponding to this distance.
4167 C Calculate the contribution to energy.
4168 ehpb=ehpb+0.5d0*waga*rdis*rdis
4169 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4170 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4171 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4173 C Evaluate gradient.
4177 c Calculate Cartesian gradient
4179 ggg(j)=fac*(c(j,jj)-c(j,ii))
4181 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4182 C If this is a SC-SC distance, we need to calculate the contributions to the
4183 C Cartesian gradient in the SC vectors (ghpbx).
4186 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4191 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4195 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4196 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4202 C--------------------------------------------------------------------------
4203 subroutine ssbond_ene(i,j,eij)
4205 C Calculate the distance and angle dependent SS-bond potential energy
4206 C using a free-energy function derived based on RHF/6-31G** ab initio
4207 C calculations of diethyl disulfide.
4209 C A. Liwo and U. Kozlowska, 11/24/03
4211 implicit real*8 (a-h,o-z)
4212 include 'DIMENSIONS'
4213 include 'COMMON.SBRIDGE'
4214 include 'COMMON.CHAIN'
4215 include 'COMMON.DERIV'
4216 include 'COMMON.LOCAL'
4217 include 'COMMON.INTERACT'
4218 include 'COMMON.VAR'
4219 include 'COMMON.IOUNITS'
4220 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4221 itypi=iabs(itype(i))
4225 dxi=dc_norm(1,nres+i)
4226 dyi=dc_norm(2,nres+i)
4227 dzi=dc_norm(3,nres+i)
4228 dsci_inv=dsc_inv(itypi)
4229 itypj=iabs(itype(j))
4230 dscj_inv=dsc_inv(itypj)
4234 dxj=dc_norm(1,nres+j)
4235 dyj=dc_norm(2,nres+j)
4236 dzj=dc_norm(3,nres+j)
4237 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4242 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4243 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4244 om12=dxi*dxj+dyi*dyj+dzi*dzj
4246 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4247 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4253 deltat12=om2-om1+2.0d0
4255 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4256 & +akct*deltad*deltat12
4257 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4258 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4259 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4260 c & " deltat12",deltat12," eij",eij
4261 ed=2*akcm*deltad+akct*deltat12
4263 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4264 eom1=-2*akth*deltat1-pom1-om2*pom2
4265 eom2= 2*akth*deltat2+pom1-om1*pom2
4268 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4271 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4272 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4273 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4274 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4277 C Calculate the components of the gradient in DC and X
4281 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4286 C--------------------------------------------------------------------------
4287 subroutine ebond(estr)
4289 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4291 implicit real*8 (a-h,o-z)
4292 include 'DIMENSIONS'
4293 include 'COMMON.LOCAL'
4294 include 'COMMON.GEO'
4295 include 'COMMON.INTERACT'
4296 include 'COMMON.DERIV'
4297 include 'COMMON.VAR'
4298 include 'COMMON.CHAIN'
4299 include 'COMMON.IOUNITS'
4300 include 'COMMON.NAMES'
4301 include 'COMMON.FFIELD'
4302 include 'COMMON.CONTROL'
4303 double precision u(3),ud(3)
4306 c write (iout,*) "distchainmax",distchainmax
4309 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
4310 diff = vbld(i)-vbldp0
4312 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4313 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4315 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4316 C & *dc(j,i-1)/vbld(i)
4318 C if (energy_dec) write(iout,*)
4319 C & "estr1",i,vbld(i),distchainmax,
4320 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4322 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4323 diff = vbld(i)-vbldpDUM
4324 C write(iout,*) i,diff
4326 diff = vbld(i)-vbldp0
4327 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4330 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4331 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4334 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4337 C write (iout,'(a7,i5,4f7.3)')
4338 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4340 estr=0.5d0*AKP*estr+estr1
4342 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4346 if (iti.ne.10 .and. iti.ne.ntyp1) then
4349 diff=vbld(i+nres)-vbldsc0(1,iti)
4350 if (energy_dec) write (iout,*)
4351 & i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4352 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4353 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4355 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4359 diff=vbld(i+nres)-vbldsc0(j,iti)
4360 ud(j)=aksc(j,iti)*diff
4361 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4375 uprod2=uprod2*u(k)*u(k)
4379 usumsqder=usumsqder+ud(j)*uprod2
4381 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4382 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4383 estr=estr+uprod/usum
4385 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4393 C--------------------------------------------------------------------------
4394 subroutine ebend(etheta,ethetacnstr)
4396 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4397 C angles gamma and its derivatives in consecutive thetas and gammas.
4399 implicit real*8 (a-h,o-z)
4400 include 'DIMENSIONS'
4401 include 'COMMON.LOCAL'
4402 include 'COMMON.GEO'
4403 include 'COMMON.INTERACT'
4404 include 'COMMON.DERIV'
4405 include 'COMMON.VAR'
4406 include 'COMMON.CHAIN'
4407 include 'COMMON.IOUNITS'
4408 include 'COMMON.NAMES'
4409 include 'COMMON.FFIELD'
4410 include 'COMMON.TORCNSTR'
4411 common /calcthet/ term1,term2,termm,diffak,ratak,
4412 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4413 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4414 double precision y(2),z(2)
4416 c time11=dexp(-2*time)
4419 c write (iout,*) "nres",nres
4420 c write (*,'(a,i2)') 'EBEND ICG=',icg
4421 c write (iout,*) ithet_start,ithet_end
4422 do i=ithet_start,ithet_end
4423 C if (itype(i-1).eq.ntyp1) cycle
4425 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4426 & .or.itype(i).eq.ntyp1) cycle
4427 C Zero the energy function and its derivative at 0 or pi.
4428 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4430 ichir1=isign(1,itype(i-2))
4431 ichir2=isign(1,itype(i))
4432 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4433 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4434 if (itype(i-1).eq.10) then
4435 itype1=isign(10,itype(i-2))
4436 ichir11=isign(1,itype(i-2))
4437 ichir12=isign(1,itype(i-2))
4438 itype2=isign(10,itype(i))
4439 ichir21=isign(1,itype(i))
4440 ichir22=isign(1,itype(i))
4447 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4451 c call proc_proc(phii,icrc)
4452 if (icrc.eq.1) phii=150.0
4463 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4467 c call proc_proc(phii1,icrc)
4468 if (icrc.eq.1) phii1=150.0
4480 C Calculate the "mean" value of theta from the part of the distribution
4481 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4482 C In following comments this theta will be referred to as t_c.
4483 thet_pred_mean=0.0d0
4485 athetk=athet(k,it,ichir1,ichir2)
4486 bthetk=bthet(k,it,ichir1,ichir2)
4488 athetk=athet(k,itype1,ichir11,ichir12)
4489 bthetk=bthet(k,itype2,ichir21,ichir22)
4491 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4493 c write (iout,*) "thet_pred_mean",thet_pred_mean
4494 dthett=thet_pred_mean*ssd
4495 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4496 c write (iout,*) "thet_pred_mean",thet_pred_mean
4497 C Derivatives of the "mean" values in gamma1 and gamma2.
4498 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4499 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4500 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4501 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4503 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4504 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4505 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4506 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4508 if (theta(i).gt.pi-delta) then
4509 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4511 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4512 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4513 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4515 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4517 else if (theta(i).lt.delta) then
4518 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4519 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4520 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4522 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4523 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4526 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4529 etheta=etheta+ethetai
4530 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4531 c & 'ebend',i,ethetai,theta(i),itype(i)
4532 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4533 c & rad2deg*phii,rad2deg*phii1,ethetai
4534 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4535 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4536 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4540 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4541 do i=1,ntheta_constr
4542 itheta=itheta_constr(i)
4543 thetiii=theta(itheta)
4544 difi=pinorm(thetiii-theta_constr0(i))
4545 if (difi.gt.theta_drange(i)) then
4546 difi=difi-theta_drange(i)
4547 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4548 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4549 & +for_thet_constr(i)*difi**3
4550 else if (difi.lt.-drange(i)) then
4552 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4553 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4554 & +for_thet_constr(i)*difi**3
4558 C if (energy_dec) then
4559 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4560 C & i,itheta,rad2deg*thetiii,
4561 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4562 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4563 C & gloc(itheta+nphi-2,icg)
4566 C Ufff.... We've done all this!!!
4569 C---------------------------------------------------------------------------
4570 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4572 implicit real*8 (a-h,o-z)
4573 include 'DIMENSIONS'
4574 include 'COMMON.LOCAL'
4575 include 'COMMON.IOUNITS'
4576 common /calcthet/ term1,term2,termm,diffak,ratak,
4577 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4578 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4579 C Calculate the contributions to both Gaussian lobes.
4580 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4581 C The "polynomial part" of the "standard deviation" of this part of
4585 sig=sig*thet_pred_mean+polthet(j,it)
4587 C Derivative of the "interior part" of the "standard deviation of the"
4588 C gamma-dependent Gaussian lobe in t_c.
4589 sigtc=3*polthet(3,it)
4591 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4594 C Set the parameters of both Gaussian lobes of the distribution.
4595 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4596 fac=sig*sig+sigc0(it)
4599 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4600 sigsqtc=-4.0D0*sigcsq*sigtc
4601 c print *,i,sig,sigtc,sigsqtc
4602 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4603 sigtc=-sigtc/(fac*fac)
4604 C Following variable is sigma(t_c)**(-2)
4605 sigcsq=sigcsq*sigcsq
4607 sig0inv=1.0D0/sig0i**2
4608 delthec=thetai-thet_pred_mean
4609 delthe0=thetai-theta0i
4610 term1=-0.5D0*sigcsq*delthec*delthec
4611 term2=-0.5D0*sig0inv*delthe0*delthe0
4612 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4613 C NaNs in taking the logarithm. We extract the largest exponent which is added
4614 C to the energy (this being the log of the distribution) at the end of energy
4615 C term evaluation for this virtual-bond angle.
4616 if (term1.gt.term2) then
4618 term2=dexp(term2-termm)
4622 term1=dexp(term1-termm)
4625 C The ratio between the gamma-independent and gamma-dependent lobes of
4626 C the distribution is a Gaussian function of thet_pred_mean too.
4627 diffak=gthet(2,it)-thet_pred_mean
4628 ratak=diffak/gthet(3,it)**2
4629 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4630 C Let's differentiate it in thet_pred_mean NOW.
4632 C Now put together the distribution terms to make complete distribution.
4633 termexp=term1+ak*term2
4634 termpre=sigc+ak*sig0i
4635 C Contribution of the bending energy from this theta is just the -log of
4636 C the sum of the contributions from the two lobes and the pre-exponential
4637 C factor. Simple enough, isn't it?
4638 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4639 C NOW the derivatives!!!
4640 C 6/6/97 Take into account the deformation.
4641 E_theta=(delthec*sigcsq*term1
4642 & +ak*delthe0*sig0inv*term2)/termexp
4643 E_tc=((sigtc+aktc*sig0i)/termpre
4644 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4645 & aktc*term2)/termexp)
4648 c-----------------------------------------------------------------------------
4649 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4650 implicit real*8 (a-h,o-z)
4651 include 'DIMENSIONS'
4652 include 'COMMON.LOCAL'
4653 include 'COMMON.IOUNITS'
4654 common /calcthet/ term1,term2,termm,diffak,ratak,
4655 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4656 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4657 delthec=thetai-thet_pred_mean
4658 delthe0=thetai-theta0i
4659 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4660 t3 = thetai-thet_pred_mean
4664 t14 = t12+t6*sigsqtc
4666 t21 = thetai-theta0i
4672 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4673 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4674 & *(-t12*t9-ak*sig0inv*t27)
4678 C--------------------------------------------------------------------------
4679 subroutine ebend(etheta)
4681 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4682 C angles gamma and its derivatives in consecutive thetas and gammas.
4683 C ab initio-derived potentials from
4684 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4686 implicit real*8 (a-h,o-z)
4687 include 'DIMENSIONS'
4688 include 'COMMON.LOCAL'
4689 include 'COMMON.GEO'
4690 include 'COMMON.INTERACT'
4691 include 'COMMON.DERIV'
4692 include 'COMMON.VAR'
4693 include 'COMMON.CHAIN'
4694 include 'COMMON.IOUNITS'
4695 include 'COMMON.NAMES'
4696 include 'COMMON.FFIELD'
4697 include 'COMMON.CONTROL'
4698 include 'COMMON.TORCNSTR'
4699 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4700 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4701 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4702 & sinph1ph2(maxdouble,maxdouble)
4703 logical lprn /.false./, lprn1 /.false./
4705 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4706 do i=ithet_start,ithet_end
4708 C if (itype(i-1).eq.ntyp1) cycle
4710 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4711 & .or.itype(i).eq.ntyp1) cycle
4712 if (iabs(itype(i+1)).eq.20) iblock=2
4713 if (iabs(itype(i+1)).ne.20) iblock=1
4717 theti2=0.5d0*theta(i)
4718 ityp2=ithetyp((itype(i-1)))
4720 coskt(k)=dcos(k*theti2)
4721 sinkt(k)=dsin(k*theti2)
4731 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4734 if (phii.ne.phii) phii=150.0
4738 ityp1=ithetyp((itype(i-2)))
4740 cosph1(k)=dcos(k*phii)
4741 sinph1(k)=dsin(k*phii)
4747 ityp1=ithetyp((itype(i-2)))
4752 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4755 if (phii1.ne.phii1) phii1=150.0
4760 ityp3=ithetyp((itype(i)))
4762 cosph2(k)=dcos(k*phii1)
4763 sinph2(k)=dsin(k*phii1)
4768 ityp3=ithetyp((itype(i)))
4774 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4775 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4777 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4780 ccl=cosph1(l)*cosph2(k-l)
4781 ssl=sinph1(l)*sinph2(k-l)
4782 scl=sinph1(l)*cosph2(k-l)
4783 csl=cosph1(l)*sinph2(k-l)
4784 cosph1ph2(l,k)=ccl-ssl
4785 cosph1ph2(k,l)=ccl+ssl
4786 sinph1ph2(l,k)=scl+csl
4787 sinph1ph2(k,l)=scl-csl
4791 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4792 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4793 write (iout,*) "coskt and sinkt"
4795 write (iout,*) k,coskt(k),sinkt(k)
4799 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4800 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4803 & write (iout,*) "k",k,"
4804 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4805 & " ethetai",ethetai
4808 write (iout,*) "cosph and sinph"
4810 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4812 write (iout,*) "cosph1ph2 and sinph2ph2"
4815 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4816 & sinph1ph2(l,k),sinph1ph2(k,l)
4819 write(iout,*) "ethetai",ethetai
4823 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4824 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4825 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4826 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4827 ethetai=ethetai+sinkt(m)*aux
4828 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4829 dephii=dephii+k*sinkt(m)*(
4830 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4831 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4832 dephii1=dephii1+k*sinkt(m)*(
4833 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4834 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4836 & write (iout,*) "m",m," k",k," bbthet",
4837 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4838 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4839 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4840 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4844 & write(iout,*) "ethetai",ethetai
4848 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4849 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4850 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4851 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4852 ethetai=ethetai+sinkt(m)*aux
4853 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4854 dephii=dephii+l*sinkt(m)*(
4855 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4856 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4857 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4858 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4859 dephii1=dephii1+(k-l)*sinkt(m)*(
4860 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4861 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4862 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4863 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4865 write (iout,*) "m",m," k",k," l",l," ffthet",
4866 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4867 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4868 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4869 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4870 & " ethetai",ethetai
4871 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4872 & cosph1ph2(k,l)*sinkt(m),
4873 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4879 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4880 & i,theta(i)*rad2deg,phii*rad2deg,
4881 & phii1*rad2deg,ethetai
4882 etheta=etheta+ethetai
4883 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4884 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4885 c gloc(nphi+i-2,icg)=wang*dethetai
4886 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4892 c-----------------------------------------------------------------------------
4893 subroutine esc(escloc)
4894 C Calculate the local energy of a side chain and its derivatives in the
4895 C corresponding virtual-bond valence angles THETA and the spherical angles
4897 implicit real*8 (a-h,o-z)
4898 include 'DIMENSIONS'
4899 include 'COMMON.GEO'
4900 include 'COMMON.LOCAL'
4901 include 'COMMON.VAR'
4902 include 'COMMON.INTERACT'
4903 include 'COMMON.DERIV'
4904 include 'COMMON.CHAIN'
4905 include 'COMMON.IOUNITS'
4906 include 'COMMON.NAMES'
4907 include 'COMMON.FFIELD'
4908 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4909 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4910 common /sccalc/ time11,time12,time112,theti,it,nlobit
4913 C write (iout,*) 'ESC'
4914 do i=loc_start,loc_end
4916 if (it.eq.ntyp1) cycle
4917 if (it.eq.10) goto 1
4918 nlobit=nlob(iabs(it))
4919 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4920 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4921 theti=theta(i+1)-pipol
4925 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4927 if (x(2).gt.pi-delta) then
4931 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4933 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4934 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4936 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4937 & ddersc0(1),dersc(1))
4938 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4939 & ddersc0(3),dersc(3))
4941 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4943 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4944 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4945 & dersc0(2),esclocbi,dersc02)
4946 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4948 call splinthet(x(2),0.5d0*delta,ss,ssd)
4953 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4955 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4956 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4958 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4960 c write (iout,*) escloci
4961 else if (x(2).lt.delta) then
4965 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4967 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4968 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4970 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4971 & ddersc0(1),dersc(1))
4972 call spline2(x(2),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),delta,-delta,esclocbi0,esclocbi1,
4979 & dersc0(2),esclocbi,dersc02)
4980 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4985 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 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4992 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4993 C write (iout,*) 'i=',i, escloci
4995 call enesc(x,escloci,dersc,ddummy,.false.)
4998 escloc=escloc+escloci
4999 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5000 write (iout,'(a6,i5,0pf7.3)')
5001 & 'escloc',i,escloci
5003 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5005 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5006 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5011 C---------------------------------------------------------------------------
5012 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5013 implicit real*8 (a-h,o-z)
5014 include 'DIMENSIONS'
5015 include 'COMMON.GEO'
5016 include 'COMMON.LOCAL'
5017 include 'COMMON.IOUNITS'
5018 common /sccalc/ time11,time12,time112,theti,it,nlobit
5019 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5020 double precision contr(maxlob,-1:1)
5022 c write (iout,*) 'it=',it,' nlobit=',nlobit
5026 if (mixed) ddersc(j)=0.0d0
5030 C Because of periodicity of the dependence of the SC energy in omega we have
5031 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5032 C To avoid underflows, first compute & store the exponents.
5040 z(k)=x(k)-censc(k,j,it)
5045 Axk=Axk+gaussc(l,k,j,it)*z(l)
5051 expfac=expfac+Ax(k,j,iii)*z(k)
5059 C As in the case of ebend, we want to avoid underflows in exponentiation and
5060 C subsequent NaNs and INFs in energy calculation.
5061 C Find the largest exponent
5065 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5069 cd print *,'it=',it,' emin=',emin
5071 C Compute the contribution to SC energy and derivatives
5075 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5076 cd print *,'j=',j,' expfac=',expfac
5077 escloc_i=escloc_i+expfac
5079 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5083 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5084 & +gaussc(k,2,j,it))*expfac
5091 dersc(1)=dersc(1)/cos(theti)**2
5092 ddersc(1)=ddersc(1)/cos(theti)**2
5095 escloci=-(dlog(escloc_i)-emin)
5097 dersc(j)=dersc(j)/escloc_i
5101 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5106 C------------------------------------------------------------------------------
5107 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5108 implicit real*8 (a-h,o-z)
5109 include 'DIMENSIONS'
5110 include 'COMMON.GEO'
5111 include 'COMMON.LOCAL'
5112 include 'COMMON.IOUNITS'
5113 common /sccalc/ time11,time12,time112,theti,it,nlobit
5114 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5115 double precision contr(maxlob)
5126 z(k)=x(k)-censc(k,j,it)
5132 Axk=Axk+gaussc(l,k,j,it)*z(l)
5138 expfac=expfac+Ax(k,j)*z(k)
5143 C As in the case of ebend, we want to avoid underflows in exponentiation and
5144 C subsequent NaNs and INFs in energy calculation.
5145 C Find the largest exponent
5148 if (emin.gt.contr(j)) emin=contr(j)
5152 C Compute the contribution to SC energy and derivatives
5156 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5157 escloc_i=escloc_i+expfac
5159 dersc(k)=dersc(k)+Ax(k,j)*expfac
5161 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5162 & +gaussc(1,2,j,it))*expfac
5166 dersc(1)=dersc(1)/cos(theti)**2
5167 dersc12=dersc12/cos(theti)**2
5168 escloci=-(dlog(escloc_i)-emin)
5170 dersc(j)=dersc(j)/escloc_i
5172 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5176 c----------------------------------------------------------------------------------
5177 subroutine esc(escloc)
5178 C Calculate the local energy of a side chain and its derivatives in the
5179 C corresponding virtual-bond valence angles THETA and the spherical angles
5180 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5181 C added by Urszula Kozlowska. 07/11/2007
5183 implicit real*8 (a-h,o-z)
5184 include 'DIMENSIONS'
5185 include 'COMMON.GEO'
5186 include 'COMMON.LOCAL'
5187 include 'COMMON.VAR'
5188 include 'COMMON.SCROT'
5189 include 'COMMON.INTERACT'
5190 include 'COMMON.DERIV'
5191 include 'COMMON.CHAIN'
5192 include 'COMMON.IOUNITS'
5193 include 'COMMON.NAMES'
5194 include 'COMMON.FFIELD'
5195 include 'COMMON.CONTROL'
5196 include 'COMMON.VECTORS'
5197 double precision x_prime(3),y_prime(3),z_prime(3)
5198 & , sumene,dsc_i,dp2_i,x(65),
5199 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5200 & de_dxx,de_dyy,de_dzz,de_dt
5201 double precision s1_t,s1_6_t,s2_t,s2_6_t
5203 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5204 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5205 & dt_dCi(3),dt_dCi1(3)
5206 common /sccalc/ time11,time12,time112,theti,it,nlobit
5209 do i=loc_start,loc_end
5210 if (itype(i).eq.ntyp1) cycle
5211 costtab(i+1) =dcos(theta(i+1))
5212 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5213 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5214 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5215 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5216 cosfac=dsqrt(cosfac2)
5217 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5218 sinfac=dsqrt(sinfac2)
5220 if (it.eq.10) goto 1
5222 C Compute the axes of tghe local cartesian coordinates system; store in
5223 c x_prime, y_prime and z_prime
5230 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5231 C & dc_norm(3,i+nres)
5233 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5234 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5237 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5240 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5241 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5242 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5243 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5244 c & " xy",scalar(x_prime(1),y_prime(1)),
5245 c & " xz",scalar(x_prime(1),z_prime(1)),
5246 c & " yy",scalar(y_prime(1),y_prime(1)),
5247 c & " yz",scalar(y_prime(1),z_prime(1)),
5248 c & " zz",scalar(z_prime(1),z_prime(1))
5250 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5251 C to local coordinate system. Store in xx, yy, zz.
5257 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5258 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5259 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5266 C Compute the energy of the ith side cbain
5268 c write (2,*) "xx",xx," yy",yy," zz",zz
5271 x(j) = sc_parmin(j,it)
5274 Cc diagnostics - remove later
5276 yy1 = dsin(alph(2))*dcos(omeg(2))
5277 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5278 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5279 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5281 C," --- ", xx_w,yy_w,zz_w
5284 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5285 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5287 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5288 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5290 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5291 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5292 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5293 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5294 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5296 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5297 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5298 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5299 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5300 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5302 dsc_i = 0.743d0+x(61)
5304 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5305 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5306 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5307 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5308 s1=(1+x(63))/(0.1d0 + dscp1)
5309 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5310 s2=(1+x(65))/(0.1d0 + dscp2)
5311 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5312 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5313 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5314 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5316 c & dscp1,dscp2,sumene
5317 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5318 escloc = escloc + sumene
5319 c write (2,*) "escloc",escloc
5320 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5322 if (.not. calc_grad) goto 1
5325 C This section to check the numerical derivatives of the energy of ith side
5326 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5327 C #define DEBUG in the code to turn it on.
5329 write (2,*) "sumene =",sumene
5333 write (2,*) xx,yy,zz
5334 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5335 de_dxx_num=(sumenep-sumene)/aincr
5337 write (2,*) "xx+ sumene from enesc=",sumenep
5340 write (2,*) xx,yy,zz
5341 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5342 de_dyy_num=(sumenep-sumene)/aincr
5344 write (2,*) "yy+ sumene from enesc=",sumenep
5347 write (2,*) xx,yy,zz
5348 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5349 de_dzz_num=(sumenep-sumene)/aincr
5351 write (2,*) "zz+ sumene from enesc=",sumenep
5352 costsave=cost2tab(i+1)
5353 sintsave=sint2tab(i+1)
5354 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5355 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5356 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5357 de_dt_num=(sumenep-sumene)/aincr
5358 write (2,*) " t+ sumene from enesc=",sumenep
5359 cost2tab(i+1)=costsave
5360 sint2tab(i+1)=sintsave
5361 C End of diagnostics section.
5364 C Compute the gradient of esc
5366 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5367 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5368 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5369 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5370 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5371 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5372 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5373 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5374 pom1=(sumene3*sint2tab(i+1)+sumene1)
5375 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5376 pom2=(sumene4*cost2tab(i+1)+sumene2)
5377 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5378 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5379 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5380 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5382 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5383 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5384 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5386 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5387 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5388 & +(pom1+pom2)*pom_dx
5390 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5393 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5394 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5395 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5397 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5398 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5399 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5400 & +x(59)*zz**2 +x(60)*xx*zz
5401 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5402 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5403 & +(pom1-pom2)*pom_dy
5405 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5408 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5409 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5410 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5411 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5412 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5413 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5414 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5415 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5417 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5420 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5421 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5422 & +pom1*pom_dt1+pom2*pom_dt2
5424 write(2,*), "de_dt = ", de_dt,de_dt_num
5428 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5429 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5430 cosfac2xx=cosfac2*xx
5431 sinfac2yy=sinfac2*yy
5433 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5435 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5437 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5438 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5439 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5440 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5441 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5442 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5443 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5444 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5445 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5446 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5450 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5451 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5452 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5453 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5456 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5457 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5458 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5460 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5461 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5465 dXX_Ctab(k,i)=dXX_Ci(k)
5466 dXX_C1tab(k,i)=dXX_Ci1(k)
5467 dYY_Ctab(k,i)=dYY_Ci(k)
5468 dYY_C1tab(k,i)=dYY_Ci1(k)
5469 dZZ_Ctab(k,i)=dZZ_Ci(k)
5470 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5471 dXX_XYZtab(k,i)=dXX_XYZ(k)
5472 dYY_XYZtab(k,i)=dYY_XYZ(k)
5473 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5477 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5478 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5479 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5480 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5481 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5483 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5484 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5485 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5486 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5487 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5488 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5489 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5490 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5492 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5493 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5495 C to check gradient call subroutine check_grad
5502 c------------------------------------------------------------------------------
5503 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5505 C This procedure calculates two-body contact function g(rij) and its derivative:
5508 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5511 C where x=(rij-r0ij)/delta
5513 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5516 double precision rij,r0ij,eps0ij,fcont,fprimcont
5517 double precision x,x2,x4,delta
5521 if (x.lt.-1.0D0) then
5524 else if (x.le.1.0D0) then
5527 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5528 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5535 c------------------------------------------------------------------------------
5536 subroutine splinthet(theti,delta,ss,ssder)
5537 implicit real*8 (a-h,o-z)
5538 include 'DIMENSIONS'
5539 include 'COMMON.VAR'
5540 include 'COMMON.GEO'
5543 if (theti.gt.pipol) then
5544 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5546 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5551 c------------------------------------------------------------------------------
5552 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5554 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5555 double precision ksi,ksi2,ksi3,a1,a2,a3
5556 a1=fprim0*delta/(f1-f0)
5562 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5563 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5566 c------------------------------------------------------------------------------
5567 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5569 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5570 double precision ksi,ksi2,ksi3,a1,a2,a3
5575 a2=3*(f1x-f0x)-2*fprim0x*delta
5576 a3=fprim0x*delta-2*(f1x-f0x)
5577 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5580 C-----------------------------------------------------------------------------
5582 C-----------------------------------------------------------------------------
5583 subroutine etor(etors,fact)
5584 implicit real*8 (a-h,o-z)
5585 include 'DIMENSIONS'
5586 include 'COMMON.VAR'
5587 include 'COMMON.GEO'
5588 include 'COMMON.LOCAL'
5589 include 'COMMON.TORSION'
5590 include 'COMMON.INTERACT'
5591 include 'COMMON.DERIV'
5592 include 'COMMON.CHAIN'
5593 include 'COMMON.NAMES'
5594 include 'COMMON.IOUNITS'
5595 include 'COMMON.FFIELD'
5596 include 'COMMON.TORCNSTR'
5598 C Set lprn=.true. for debugging
5602 do i=iphi_start,iphi_end
5603 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5604 & .or. itype(i).eq.ntyp1) cycle
5605 itori=itortyp(itype(i-2))
5606 itori1=itortyp(itype(i-1))
5609 C Proline-Proline pair is a special case...
5610 if (itori.eq.3 .and. itori1.eq.3) then
5611 if (phii.gt.-dwapi3) then
5613 fac=1.0D0/(1.0D0-cosphi)
5614 etorsi=v1(1,3,3)*fac
5615 etorsi=etorsi+etorsi
5616 etors=etors+etorsi-v1(1,3,3)
5617 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5620 v1ij=v1(j+1,itori,itori1)
5621 v2ij=v2(j+1,itori,itori1)
5624 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5625 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5629 v1ij=v1(j,itori,itori1)
5630 v2ij=v2(j,itori,itori1)
5633 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5634 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5638 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5639 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5640 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5641 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5642 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5646 c------------------------------------------------------------------------------
5648 subroutine etor(etors,fact)
5649 implicit real*8 (a-h,o-z)
5650 include 'DIMENSIONS'
5651 include 'COMMON.VAR'
5652 include 'COMMON.GEO'
5653 include 'COMMON.LOCAL'
5654 include 'COMMON.TORSION'
5655 include 'COMMON.INTERACT'
5656 include 'COMMON.DERIV'
5657 include 'COMMON.CHAIN'
5658 include 'COMMON.NAMES'
5659 include 'COMMON.IOUNITS'
5660 include 'COMMON.FFIELD'
5661 include 'COMMON.TORCNSTR'
5663 C Set lprn=.true. for debugging
5667 do i=iphi_start,iphi_end
5669 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5670 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5671 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5672 C & .or. itype(i).eq.ntyp1) cycle
5673 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5674 if (iabs(itype(i)).eq.20) then
5679 itori=itortyp(itype(i-2))
5680 itori1=itortyp(itype(i-1))
5683 C Regular cosine and sine terms
5684 do j=1,nterm(itori,itori1,iblock)
5685 v1ij=v1(j,itori,itori1,iblock)
5686 v2ij=v2(j,itori,itori1,iblock)
5689 etors=etors+v1ij*cosphi+v2ij*sinphi
5690 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5694 C E = SUM ----------------------------------- - v1
5695 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5697 cosphi=dcos(0.5d0*phii)
5698 sinphi=dsin(0.5d0*phii)
5699 do j=1,nlor(itori,itori1,iblock)
5700 vl1ij=vlor1(j,itori,itori1)
5701 vl2ij=vlor2(j,itori,itori1)
5702 vl3ij=vlor3(j,itori,itori1)
5703 pom=vl2ij*cosphi+vl3ij*sinphi
5704 pom1=1.0d0/(pom*pom+1.0d0)
5705 etors=etors+vl1ij*pom1
5706 c if (energy_dec) etors_ii=etors_ii+
5709 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5711 C Subtract the constant term
5712 etors=etors-v0(itori,itori1,iblock)
5714 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5715 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5716 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5717 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5718 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5723 c----------------------------------------------------------------------------
5724 subroutine etor_d(etors_d,fact2)
5725 C 6/23/01 Compute double torsional energy
5726 implicit real*8 (a-h,o-z)
5727 include 'DIMENSIONS'
5728 include 'COMMON.VAR'
5729 include 'COMMON.GEO'
5730 include 'COMMON.LOCAL'
5731 include 'COMMON.TORSION'
5732 include 'COMMON.INTERACT'
5733 include 'COMMON.DERIV'
5734 include 'COMMON.CHAIN'
5735 include 'COMMON.NAMES'
5736 include 'COMMON.IOUNITS'
5737 include 'COMMON.FFIELD'
5738 include 'COMMON.TORCNSTR'
5740 C Set lprn=.true. for debugging
5744 do i=iphi_start,iphi_end-1
5746 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5747 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5748 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5749 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5750 & (itype(i+1).eq.ntyp1)) cycle
5751 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5753 itori=itortyp(itype(i-2))
5754 itori1=itortyp(itype(i-1))
5755 itori2=itortyp(itype(i))
5761 if (iabs(itype(i+1)).eq.20) iblock=2
5762 C Regular cosine and sine terms
5763 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5764 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5765 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5766 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5767 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5768 cosphi1=dcos(j*phii)
5769 sinphi1=dsin(j*phii)
5770 cosphi2=dcos(j*phii1)
5771 sinphi2=dsin(j*phii1)
5772 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5773 & v2cij*cosphi2+v2sij*sinphi2
5774 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5775 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5777 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5779 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5780 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5781 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5782 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5783 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5784 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5785 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5786 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5787 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5788 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5789 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5790 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5791 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5792 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5795 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5796 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5802 c---------------------------------------------------------------------------
5803 C The rigorous attempt to derive energy function
5804 subroutine etor_kcc(etors,fact)
5805 implicit real*8 (a-h,o-z)
5806 include 'DIMENSIONS'
5807 include 'COMMON.VAR'
5808 include 'COMMON.GEO'
5809 include 'COMMON.LOCAL'
5810 include 'COMMON.TORSION'
5811 include 'COMMON.INTERACT'
5812 include 'COMMON.DERIV'
5813 include 'COMMON.CHAIN'
5814 include 'COMMON.NAMES'
5815 include 'COMMON.IOUNITS'
5816 include 'COMMON.FFIELD'
5817 include 'COMMON.TORCNSTR'
5818 include 'COMMON.CONTROL'
5819 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
5821 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
5822 C Set lprn=.true. for debugging
5825 C print *,"wchodze kcc"
5826 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
5828 do i=iphi_start,iphi_end
5829 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5830 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5831 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5832 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5833 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5834 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5835 itori=itortyp(itype(i-2))
5836 itori1=itortyp(itype(i-1))
5841 C to avoid multiple devision by 2
5842 c theti22=0.5d0*theta(i)
5843 C theta 12 is the theta_1 /2
5844 C theta 22 is theta_2 /2
5845 c theti12=0.5d0*theta(i-1)
5846 C and appropriate sinus function
5847 sinthet1=dsin(theta(i-1))
5848 sinthet2=dsin(theta(i))
5849 costhet1=dcos(theta(i-1))
5850 costhet2=dcos(theta(i))
5851 C to speed up lets store its mutliplication
5852 sint1t2=sinthet2*sinthet1
5854 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
5855 C +d_n*sin(n*gamma)) *
5856 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
5857 C we have two sum 1) Non-Chebyshev which is with n and gamma
5858 nval=nterm_kcc_Tb(itori,itori1)
5864 c1(j)=c1(j-1)*costhet1
5865 c2(j)=c2(j-1)*costhet2
5868 do j=1,nterm_kcc(itori,itori1)
5872 sint1t2n=sint1t2n*sint1t2
5878 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5879 gradvalct1=gradvalct1+
5880 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5881 gradvalct2=gradvalct2+
5882 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5885 gradvalct1=-gradvalct1*sinthet1
5886 gradvalct2=-gradvalct2*sinthet2
5892 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5893 gradvalst1=gradvalst1+
5894 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5895 gradvalst2=gradvalst2+
5896 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5899 gradvalst1=-gradvalst1*sinthet1
5900 gradvalst2=-gradvalst2*sinthet2
5901 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
5902 C glocig is the gradient local i site in gamma
5903 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
5904 C now gradient over theta_1
5905 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
5906 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
5907 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
5908 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
5911 C derivative over gamma
5912 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
5913 C derivative over theta1
5914 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
5915 C now derivative over theta2
5916 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
5918 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
5919 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
5923 c---------------------------------------------------------------------------------------------
5924 subroutine etor_constr(edihcnstr)
5925 implicit real*8 (a-h,o-z)
5926 include 'DIMENSIONS'
5927 include 'COMMON.VAR'
5928 include 'COMMON.GEO'
5929 include 'COMMON.LOCAL'
5930 include 'COMMON.TORSION'
5931 include 'COMMON.INTERACT'
5932 include 'COMMON.DERIV'
5933 include 'COMMON.CHAIN'
5934 include 'COMMON.NAMES'
5935 include 'COMMON.IOUNITS'
5936 include 'COMMON.FFIELD'
5937 include 'COMMON.TORCNSTR'
5938 include 'COMMON.CONTROL'
5939 ! 6/20/98 - dihedral angle constraints
5941 c do i=1,ndih_constr
5942 c write (iout,*) "idihconstr_start",idihconstr_start,
5943 c & " idihconstr_end",idihconstr_end
5944 if (raw_psipred) then
5945 do i=idihconstr_start,idihconstr_end
5946 itori=idih_constr(i)
5948 gaudih_i=vpsipred(1,i)
5952 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
5953 dexpcos_i=dexp(-cos_i*cos_i)
5954 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
5955 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
5956 & *cos_i*dexpcos_i/s**2
5958 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
5959 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
5961 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
5962 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
5963 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
5964 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
5965 & -wdihc*dlog(gaudih_i)
5968 do i=idihconstr_start,idihconstr_end
5969 itori=idih_constr(i)
5971 difi=pinorm(phii-phi0(i))
5972 if (difi.gt.drange(i)) then
5974 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5975 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5976 else if (difi.lt.-drange(i)) then
5978 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5979 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5987 c----------------------------------------------------------------------------
5988 C The rigorous attempt to derive energy function
5989 subroutine ebend_kcc(etheta)
5991 implicit real*8 (a-h,o-z)
5992 include 'DIMENSIONS'
5993 include 'COMMON.VAR'
5994 include 'COMMON.GEO'
5995 include 'COMMON.LOCAL'
5996 include 'COMMON.TORSION'
5997 include 'COMMON.INTERACT'
5998 include 'COMMON.DERIV'
5999 include 'COMMON.CHAIN'
6000 include 'COMMON.NAMES'
6001 include 'COMMON.IOUNITS'
6002 include 'COMMON.FFIELD'
6003 include 'COMMON.TORCNSTR'
6004 include 'COMMON.CONTROL'
6006 double precision thybt1(maxang_kcc)
6007 C Set lprn=.true. for debugging
6010 C print *,"wchodze kcc"
6011 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6013 do i=ithet_start,ithet_end
6014 c print *,i,itype(i-1),itype(i),itype(i-2)
6015 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6016 & .or.itype(i).eq.ntyp1) cycle
6017 iti=iabs(itortyp(itype(i-1)))
6018 sinthet=dsin(theta(i))
6019 costhet=dcos(theta(i))
6020 do j=1,nbend_kcc_Tb(iti)
6021 thybt1(j)=v1bend_chyb(j,iti)
6023 sumth1thyb=v1bend_chyb(0,iti)+
6024 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6025 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6027 ihelp=nbend_kcc_Tb(iti)-1
6028 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6029 etheta=etheta+sumth1thyb
6030 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6031 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6035 c-------------------------------------------------------------------------------------
6036 subroutine etheta_constr(ethetacnstr)
6038 implicit real*8 (a-h,o-z)
6039 include 'DIMENSIONS'
6040 include 'COMMON.VAR'
6041 include 'COMMON.GEO'
6042 include 'COMMON.LOCAL'
6043 include 'COMMON.TORSION'
6044 include 'COMMON.INTERACT'
6045 include 'COMMON.DERIV'
6046 include 'COMMON.CHAIN'
6047 include 'COMMON.NAMES'
6048 include 'COMMON.IOUNITS'
6049 include 'COMMON.FFIELD'
6050 include 'COMMON.TORCNSTR'
6051 include 'COMMON.CONTROL'
6053 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6054 do i=ithetaconstr_start,ithetaconstr_end
6055 itheta=itheta_constr(i)
6056 thetiii=theta(itheta)
6057 difi=pinorm(thetiii-theta_constr0(i))
6058 if (difi.gt.theta_drange(i)) then
6059 difi=difi-theta_drange(i)
6060 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6061 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6062 & +for_thet_constr(i)*difi**3
6063 else if (difi.lt.-drange(i)) then
6065 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6066 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6067 & +for_thet_constr(i)*difi**3
6071 if (energy_dec) then
6072 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6073 & i,itheta,rad2deg*thetiii,
6074 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6075 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6076 & gloc(itheta+nphi-2,icg)
6081 c------------------------------------------------------------------------------
6082 c------------------------------------------------------------------------------
6083 subroutine eback_sc_corr(esccor)
6084 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6085 c conformational states; temporarily implemented as differences
6086 c between UNRES torsional potentials (dependent on three types of
6087 c residues) and the torsional potentials dependent on all 20 types
6088 c of residues computed from AM1 energy surfaces of terminally-blocked
6089 c amino-acid residues.
6090 implicit real*8 (a-h,o-z)
6091 include 'DIMENSIONS'
6092 include 'COMMON.VAR'
6093 include 'COMMON.GEO'
6094 include 'COMMON.LOCAL'
6095 include 'COMMON.TORSION'
6096 include 'COMMON.SCCOR'
6097 include 'COMMON.INTERACT'
6098 include 'COMMON.DERIV'
6099 include 'COMMON.CHAIN'
6100 include 'COMMON.NAMES'
6101 include 'COMMON.IOUNITS'
6102 include 'COMMON.FFIELD'
6103 include 'COMMON.CONTROL'
6105 C Set lprn=.true. for debugging
6108 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6110 do i=itau_start,itau_end
6111 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6113 isccori=isccortyp(itype(i-2))
6114 isccori1=isccortyp(itype(i-1))
6116 do intertyp=1,3 !intertyp
6117 cc Added 09 May 2012 (Adasko)
6118 cc Intertyp means interaction type of backbone mainchain correlation:
6119 c 1 = SC...Ca...Ca...Ca
6120 c 2 = Ca...Ca...Ca...SC
6121 c 3 = SC...Ca...Ca...SCi
6123 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6124 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6125 & (itype(i-1).eq.ntyp1)))
6126 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6127 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6128 & .or.(itype(i).eq.ntyp1)))
6129 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6130 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6131 & (itype(i-3).eq.ntyp1)))) cycle
6132 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6133 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6135 do j=1,nterm_sccor(isccori,isccori1)
6136 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6137 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6138 cosphi=dcos(j*tauangle(intertyp,i))
6139 sinphi=dsin(j*tauangle(intertyp,i))
6140 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6141 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6143 C write (iout,*)"EBACK_SC_COR",esccor,i
6144 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6145 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6146 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6148 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6149 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6150 & (v1sccor(j,1,itori,itori1),j=1,6)
6151 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6152 c gsccor_loc(i-3)=gloci
6158 c------------------------------------------------------------------------------
6159 subroutine multibody(ecorr)
6160 C This subroutine calculates multi-body contributions to energy following
6161 C the idea of Skolnick et al. If side chains I and J make a contact and
6162 C at the same time side chains I+1 and J+1 make a contact, an extra
6163 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6164 implicit real*8 (a-h,o-z)
6165 include 'DIMENSIONS'
6166 include 'COMMON.IOUNITS'
6167 include 'COMMON.DERIV'
6168 include 'COMMON.INTERACT'
6169 include 'COMMON.CONTACTS'
6170 include 'COMMON.CONTMAT'
6171 include 'COMMON.CORRMAT'
6172 double precision gx(3),gx1(3)
6175 C Set lprn=.true. for debugging
6179 write (iout,'(a)') 'Contact function values:'
6181 write (iout,'(i2,20(1x,i2,f10.5))')
6182 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6197 num_conti=num_cont(i)
6198 num_conti1=num_cont(i1)
6203 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6204 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6205 cd & ' ishift=',ishift
6206 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6207 C The system gains extra energy.
6208 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6209 endif ! j1==j+-ishift
6218 c------------------------------------------------------------------------------
6219 double precision function esccorr(i,j,k,l,jj,kk)
6220 implicit real*8 (a-h,o-z)
6221 include 'DIMENSIONS'
6222 include 'COMMON.IOUNITS'
6223 include 'COMMON.DERIV'
6224 include 'COMMON.INTERACT'
6225 include 'COMMON.CONTACTS'
6226 include 'COMMON.CONTMAT'
6227 include 'COMMON.CORRMAT'
6228 double precision gx(3),gx1(3)
6233 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6234 C Calculate the multi-body contribution to energy.
6235 C Calculate multi-body contributions to the gradient.
6236 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6237 cd & k,l,(gacont(m,kk,k),m=1,3)
6239 gx(m) =ekl*gacont(m,jj,i)
6240 gx1(m)=eij*gacont(m,kk,k)
6241 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6242 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6243 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6244 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6248 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6253 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6259 c------------------------------------------------------------------------------
6260 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6261 C This subroutine calculates multi-body contributions to hydrogen-bonding
6262 implicit real*8 (a-h,o-z)
6263 include 'DIMENSIONS'
6264 include 'COMMON.IOUNITS'
6265 include 'COMMON.FFIELD'
6266 include 'COMMON.DERIV'
6267 include 'COMMON.INTERACT'
6268 include 'COMMON.CONTACTS'
6269 include 'COMMON.CONTMAT'
6270 include 'COMMON.CORRMAT'
6271 double precision gx(3),gx1(3)
6274 C Set lprn=.true. for debugging
6277 write (iout,'(a)') 'Contact function values:'
6279 write (iout,'(2i3,50(1x,i2,f5.2))')
6280 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6281 & j=1,num_cont_hb(i))
6285 C Remove the loop below after debugging !!!
6292 C Calculate the local-electrostatic correlation terms
6293 do i=iatel_s,iatel_e+1
6295 num_conti=num_cont_hb(i)
6296 num_conti1=num_cont_hb(i+1)
6301 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6302 c & ' jj=',jj,' kk=',kk
6303 if (j1.eq.j+1 .or. j1.eq.j-1) then
6304 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6305 C The system gains extra energy.
6306 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6308 else if (j1.eq.j) then
6309 C Contacts I-J and I-(J+1) occur simultaneously.
6310 C The system loses extra energy.
6311 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6316 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6317 c & ' jj=',jj,' kk=',kk
6319 C Contacts I-J and (I+1)-J occur simultaneously.
6320 C The system loses extra energy.
6321 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6328 c------------------------------------------------------------------------------
6329 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6331 C This subroutine calculates multi-body contributions to hydrogen-bonding
6332 implicit real*8 (a-h,o-z)
6333 include 'DIMENSIONS'
6334 include 'COMMON.IOUNITS'
6338 include 'COMMON.FFIELD'
6339 include 'COMMON.DERIV'
6340 include 'COMMON.LOCAL'
6341 include 'COMMON.INTERACT'
6342 include 'COMMON.CONTACTS'
6343 include 'COMMON.CONTMAT'
6344 include 'COMMON.CORRMAT'
6345 include 'COMMON.CHAIN'
6346 include 'COMMON.CONTROL'
6347 include 'COMMON.SHIELD'
6348 double precision gx(3),gx1(3)
6349 integer num_cont_hb_old(maxres)
6351 double precision eello4,eello5,eelo6,eello_turn6
6352 external eello4,eello5,eello6,eello_turn6
6353 C Set lprn=.true. for debugging
6357 write (iout,'(a)') 'Contact function values:'
6359 write (iout,'(2i3,50(1x,i2,5f6.3))')
6360 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6361 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6367 C Remove the loop below after debugging !!!
6374 C Calculate the dipole-dipole interaction energies
6375 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6376 do i=iatel_s,iatel_e+1
6377 num_conti=num_cont_hb(i)
6386 C Calculate the local-electrostatic correlation terms
6387 c write (iout,*) "gradcorr5 in eello5 before loop"
6389 c write (iout,'(i5,3f10.5)')
6390 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6392 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6393 c write (iout,*) "corr loop i",i
6395 num_conti=num_cont_hb(i)
6396 num_conti1=num_cont_hb(i+1)
6403 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6404 c & ' jj=',jj,' kk=',kk
6405 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6406 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6407 & .or. j.lt.0 .and. j1.gt.0) .and.
6408 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6409 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6410 C The system gains extra energy.
6412 sqd1=dsqrt(d_cont(jj,i))
6413 sqd2=dsqrt(d_cont(kk,i1))
6414 sred_geom = sqd1*sqd2
6415 IF (sred_geom.lt.cutoff_corr) THEN
6416 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6418 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6419 cd & ' jj=',jj,' kk=',kk
6420 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6421 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6423 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6424 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6427 cd write (iout,*) 'sred_geom=',sred_geom,
6428 cd & ' ekont=',ekont,' fprim=',fprimcont,
6429 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6430 cd write (iout,*) "g_contij",g_contij
6431 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6432 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6433 call calc_eello(i,jp,i+1,jp1,jj,kk)
6434 if (wcorr4.gt.0.0d0)
6435 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6436 CC & *fac_shield(i)**2*fac_shield(j)**2
6437 if (energy_dec.and.wcorr4.gt.0.0d0)
6438 1 write (iout,'(a6,4i5,0pf7.3)')
6439 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6440 c write (iout,*) "gradcorr5 before eello5"
6442 c write (iout,'(i5,3f10.5)')
6443 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6445 if (wcorr5.gt.0.0d0)
6446 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6447 c write (iout,*) "gradcorr5 after eello5"
6449 c write (iout,'(i5,3f10.5)')
6450 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6452 if (energy_dec.and.wcorr5.gt.0.0d0)
6453 1 write (iout,'(a6,4i5,0pf7.3)')
6454 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6455 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6456 cd write(2,*)'ijkl',i,jp,i+1,jp1
6457 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6458 & .or. wturn6.eq.0.0d0))then
6459 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6460 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6461 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6462 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6463 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6464 cd & 'ecorr6=',ecorr6
6465 cd write (iout,'(4e15.5)') sred_geom,
6466 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6467 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6468 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6469 else if (wturn6.gt.0.0d0
6470 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6471 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6472 eturn6=eturn6+eello_turn6(i,jj,kk)
6473 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6474 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6475 cd write (2,*) 'multibody_eello:eturn6',eturn6
6484 num_cont_hb(i)=num_cont_hb_old(i)
6486 c write (iout,*) "gradcorr5 in eello5"
6488 c write (iout,'(i5,3f10.5)')
6489 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6493 c------------------------------------------------------------------------------
6494 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6495 implicit real*8 (a-h,o-z)
6496 include 'DIMENSIONS'
6497 include 'COMMON.IOUNITS'
6498 include 'COMMON.DERIV'
6499 include 'COMMON.INTERACT'
6500 include 'COMMON.CONTACTS'
6501 include 'COMMON.CONTMAT'
6502 include 'COMMON.CORRMAT'
6503 include 'COMMON.SHIELD'
6504 include 'COMMON.CONTROL'
6505 double precision gx(3),gx1(3)
6508 C print *,"wchodze",fac_shield(i),shield_mode
6516 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6518 C & fac_shield(i)**2*fac_shield(j)**2
6519 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6520 C Following 4 lines for diagnostics.
6525 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6526 c & 'Contacts ',i,j,
6527 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6528 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6530 C Calculate the multi-body contribution to energy.
6531 C ecorr=ecorr+ekont*ees
6532 C Calculate multi-body contributions to the gradient.
6533 coeffpees0pij=coeffp*ees0pij
6534 coeffmees0mij=coeffm*ees0mij
6535 coeffpees0pkl=coeffp*ees0pkl
6536 coeffmees0mkl=coeffm*ees0mkl
6538 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6539 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6540 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6541 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6542 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6543 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6544 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6545 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6546 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6547 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6548 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6549 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6550 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6551 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6552 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6553 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6554 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6555 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6556 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6557 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6558 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6559 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6560 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6561 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6562 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6567 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6568 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6569 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6570 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6575 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6576 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6577 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6578 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6581 c write (iout,*) "ehbcorr",ekont*ees
6582 C print *,ekont,ees,i,k
6584 C now gradient over shielding
6586 if (shield_mode.gt.0) then
6589 C print *,i,j,fac_shield(i),fac_shield(j),
6590 C &fac_shield(k),fac_shield(l)
6591 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6592 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6593 do ilist=1,ishield_list(i)
6594 iresshield=shield_list(ilist,i)
6596 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6598 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6600 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6601 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6605 do ilist=1,ishield_list(j)
6606 iresshield=shield_list(ilist,j)
6608 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6610 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6612 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6613 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6618 do ilist=1,ishield_list(k)
6619 iresshield=shield_list(ilist,k)
6621 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6623 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6625 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6626 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6630 do ilist=1,ishield_list(l)
6631 iresshield=shield_list(ilist,l)
6633 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6635 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6637 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6638 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6642 C print *,gshieldx(m,iresshield)
6644 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6645 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6646 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6647 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6648 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6649 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6650 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6651 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6653 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6654 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6655 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6656 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6657 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6658 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6659 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6660 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6668 C---------------------------------------------------------------------------
6669 subroutine dipole(i,j,jj)
6670 implicit real*8 (a-h,o-z)
6671 include 'DIMENSIONS'
6672 include 'COMMON.IOUNITS'
6673 include 'COMMON.CHAIN'
6674 include 'COMMON.FFIELD'
6675 include 'COMMON.DERIV'
6676 include 'COMMON.INTERACT'
6677 include 'COMMON.CONTACTS'
6678 include 'COMMON.CONTMAT'
6679 include 'COMMON.CORRMAT'
6680 include 'COMMON.TORSION'
6681 include 'COMMON.VAR'
6682 include 'COMMON.GEO'
6683 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6685 iti1 = itortyp(itype(i+1))
6686 if (j.lt.nres-1) then
6687 itj1 = itype2loc(itype(j+1))
6692 dipi(iii,1)=Ub2(iii,i)
6693 dipderi(iii)=Ub2der(iii,i)
6694 dipi(iii,2)=b1(iii,i+1)
6695 dipj(iii,1)=Ub2(iii,j)
6696 dipderj(iii)=Ub2der(iii,j)
6697 dipj(iii,2)=b1(iii,j+1)
6701 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6704 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6711 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6715 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6720 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6721 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6723 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6725 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6727 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6732 C---------------------------------------------------------------------------
6733 subroutine calc_eello(i,j,k,l,jj,kk)
6735 C This subroutine computes matrices and vectors needed to calculate
6736 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6738 implicit real*8 (a-h,o-z)
6739 include 'DIMENSIONS'
6740 include 'COMMON.IOUNITS'
6741 include 'COMMON.CHAIN'
6742 include 'COMMON.DERIV'
6743 include 'COMMON.INTERACT'
6744 include 'COMMON.CONTACTS'
6745 include 'COMMON.CONTMAT'
6746 include 'COMMON.CORRMAT'
6747 include 'COMMON.TORSION'
6748 include 'COMMON.VAR'
6749 include 'COMMON.GEO'
6750 include 'COMMON.FFIELD'
6751 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6752 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6755 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6756 cd & ' jj=',jj,' kk=',kk
6757 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6758 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6759 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6762 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6763 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6766 call transpose2(aa1(1,1),aa1t(1,1))
6767 call transpose2(aa2(1,1),aa2t(1,1))
6770 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6771 & aa1tder(1,1,lll,kkk))
6772 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6773 & aa2tder(1,1,lll,kkk))
6777 C parallel orientation of the two CA-CA-CA frames.
6779 iti=itype2loc(itype(i))
6783 itk1=itype2loc(itype(k+1))
6784 itj=itype2loc(itype(j))
6785 if (l.lt.nres-1) then
6786 itl1=itype2loc(itype(l+1))
6790 C A1 kernel(j+1) A2T
6792 cd write (iout,'(3f10.5,5x,3f10.5)')
6793 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6795 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6796 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6797 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6798 C Following matrices are needed only for 6-th order cumulants
6799 IF (wcorr6.gt.0.0d0) THEN
6800 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6801 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6802 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6803 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6804 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6805 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6806 & ADtEAderx(1,1,1,1,1,1))
6808 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6809 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6810 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6811 & ADtEA1derx(1,1,1,1,1,1))
6813 C End 6-th order cumulants
6816 cd write (2,*) 'In calc_eello6'
6818 cd write (2,*) 'iii=',iii
6820 cd write (2,*) 'kkk=',kkk
6822 cd write (2,'(3(2f10.5),5x)')
6823 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6828 call transpose2(EUgder(1,1,k),auxmat(1,1))
6829 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6830 call transpose2(EUg(1,1,k),auxmat(1,1))
6831 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6832 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6836 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6837 & EAEAderx(1,1,lll,kkk,iii,1))
6841 C A1T kernel(i+1) A2
6842 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6843 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6844 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6845 C Following matrices are needed only for 6-th order cumulants
6846 IF (wcorr6.gt.0.0d0) THEN
6847 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6848 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6849 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6850 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6851 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6852 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6853 & ADtEAderx(1,1,1,1,1,2))
6854 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6855 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6856 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6857 & ADtEA1derx(1,1,1,1,1,2))
6859 C End 6-th order cumulants
6860 call transpose2(EUgder(1,1,l),auxmat(1,1))
6861 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6862 call transpose2(EUg(1,1,l),auxmat(1,1))
6863 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6864 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6868 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6869 & EAEAderx(1,1,lll,kkk,iii,2))
6874 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6875 C They are needed only when the fifth- or the sixth-order cumulants are
6877 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6878 call transpose2(AEA(1,1,1),auxmat(1,1))
6879 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
6880 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6881 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6882 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6883 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
6884 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6885 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
6886 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
6887 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6888 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6889 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6890 call transpose2(AEA(1,1,2),auxmat(1,1))
6891 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
6892 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6893 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6894 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6895 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
6896 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6897 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
6898 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
6899 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6900 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6901 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6902 C Calculate the Cartesian derivatives of the vectors.
6906 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6907 call matvec2(auxmat(1,1),b1(1,i),
6908 & AEAb1derx(1,lll,kkk,iii,1,1))
6909 call matvec2(auxmat(1,1),Ub2(1,i),
6910 & AEAb2derx(1,lll,kkk,iii,1,1))
6911 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
6912 & AEAb1derx(1,lll,kkk,iii,2,1))
6913 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6914 & AEAb2derx(1,lll,kkk,iii,2,1))
6915 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6916 call matvec2(auxmat(1,1),b1(1,j),
6917 & AEAb1derx(1,lll,kkk,iii,1,2))
6918 call matvec2(auxmat(1,1),Ub2(1,j),
6919 & AEAb2derx(1,lll,kkk,iii,1,2))
6920 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
6921 & AEAb1derx(1,lll,kkk,iii,2,2))
6922 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6923 & AEAb2derx(1,lll,kkk,iii,2,2))
6930 C Antiparallel orientation of the two CA-CA-CA frames.
6932 iti=itype2loc(itype(i))
6936 itk1=itype2loc(itype(k+1))
6937 itl=itype2loc(itype(l))
6938 itj=itype2loc(itype(j))
6939 if (j.lt.nres-1) then
6940 itj1=itype2loc(itype(j+1))
6944 C A2 kernel(j-1)T A1T
6945 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6946 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6947 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6948 C Following matrices are needed only for 6-th order cumulants
6949 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6950 & j.eq.i+4 .and. l.eq.i+3)) THEN
6951 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6952 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6953 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6954 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6955 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6956 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6957 & ADtEAderx(1,1,1,1,1,1))
6958 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6959 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6960 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6961 & ADtEA1derx(1,1,1,1,1,1))
6963 C End 6-th order cumulants
6964 call transpose2(EUgder(1,1,k),auxmat(1,1))
6965 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6966 call transpose2(EUg(1,1,k),auxmat(1,1))
6967 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6968 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6972 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6973 & EAEAderx(1,1,lll,kkk,iii,1))
6977 C A2T kernel(i+1)T A1
6978 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6979 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6980 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6981 C Following matrices are needed only for 6-th order cumulants
6982 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6983 & j.eq.i+4 .and. l.eq.i+3)) THEN
6984 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6985 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6986 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6987 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6988 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6989 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6990 & ADtEAderx(1,1,1,1,1,2))
6991 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6992 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6993 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6994 & ADtEA1derx(1,1,1,1,1,2))
6996 C End 6-th order cumulants
6997 call transpose2(EUgder(1,1,j),auxmat(1,1))
6998 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6999 call transpose2(EUg(1,1,j),auxmat(1,1))
7000 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7001 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7005 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7006 & EAEAderx(1,1,lll,kkk,iii,2))
7011 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7012 C They are needed only when the fifth- or the sixth-order cumulants are
7014 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7015 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7016 call transpose2(AEA(1,1,1),auxmat(1,1))
7017 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7018 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7019 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7020 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7021 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7022 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7023 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7024 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7025 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7026 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7027 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7028 call transpose2(AEA(1,1,2),auxmat(1,1))
7029 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7030 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7031 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7032 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7033 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7034 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7035 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7036 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7037 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7038 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7039 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7040 C Calculate the Cartesian derivatives of the vectors.
7044 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7045 call matvec2(auxmat(1,1),b1(1,i),
7046 & AEAb1derx(1,lll,kkk,iii,1,1))
7047 call matvec2(auxmat(1,1),Ub2(1,i),
7048 & AEAb2derx(1,lll,kkk,iii,1,1))
7049 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7050 & AEAb1derx(1,lll,kkk,iii,2,1))
7051 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7052 & AEAb2derx(1,lll,kkk,iii,2,1))
7053 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7054 call matvec2(auxmat(1,1),b1(1,l),
7055 & AEAb1derx(1,lll,kkk,iii,1,2))
7056 call matvec2(auxmat(1,1),Ub2(1,l),
7057 & AEAb2derx(1,lll,kkk,iii,1,2))
7058 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7059 & AEAb1derx(1,lll,kkk,iii,2,2))
7060 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7061 & AEAb2derx(1,lll,kkk,iii,2,2))
7070 C---------------------------------------------------------------------------
7071 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7072 & KK,KKderg,AKA,AKAderg,AKAderx)
7076 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7077 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7078 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7083 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7085 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7088 cd if (lprn) write (2,*) 'In kernel'
7090 cd if (lprn) write (2,*) 'kkk=',kkk
7092 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7093 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7095 cd write (2,*) 'lll=',lll
7096 cd write (2,*) 'iii=1'
7098 cd write (2,'(3(2f10.5),5x)')
7099 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7102 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7103 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7105 cd write (2,*) 'lll=',lll
7106 cd write (2,*) 'iii=2'
7108 cd write (2,'(3(2f10.5),5x)')
7109 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7116 C---------------------------------------------------------------------------
7117 double precision function eello4(i,j,k,l,jj,kk)
7118 implicit real*8 (a-h,o-z)
7119 include 'DIMENSIONS'
7120 include 'COMMON.IOUNITS'
7121 include 'COMMON.CHAIN'
7122 include 'COMMON.DERIV'
7123 include 'COMMON.INTERACT'
7124 include 'COMMON.CONTACTS'
7125 include 'COMMON.CONTMAT'
7126 include 'COMMON.CORRMAT'
7127 include 'COMMON.TORSION'
7128 include 'COMMON.VAR'
7129 include 'COMMON.GEO'
7130 double precision pizda(2,2),ggg1(3),ggg2(3)
7131 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7135 cd print *,'eello4:',i,j,k,l,jj,kk
7136 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7137 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7138 cold eij=facont_hb(jj,i)
7139 cold ekl=facont_hb(kk,k)
7141 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7143 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7144 gcorr_loc(k-1)=gcorr_loc(k-1)
7145 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7147 gcorr_loc(l-1)=gcorr_loc(l-1)
7148 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7150 gcorr_loc(j-1)=gcorr_loc(j-1)
7151 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7156 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7157 & -EAEAderx(2,2,lll,kkk,iii,1)
7158 cd derx(lll,kkk,iii)=0.0d0
7162 cd gcorr_loc(l-1)=0.0d0
7163 cd gcorr_loc(j-1)=0.0d0
7164 cd gcorr_loc(k-1)=0.0d0
7166 cd write (iout,*)'Contacts have occurred for peptide groups',
7167 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7168 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7169 if (j.lt.nres-1) then
7176 if (l.lt.nres-1) then
7184 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7185 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7186 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7187 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7188 cgrad ghalf=0.5d0*ggg1(ll)
7189 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7190 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7191 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7192 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7193 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7194 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7195 cgrad ghalf=0.5d0*ggg2(ll)
7196 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7197 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7198 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7199 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7200 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7201 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7205 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7210 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7215 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7220 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7224 cd write (2,*) iii,gcorr_loc(iii)
7228 cd write (2,*) 'ekont',ekont
7229 cd write (iout,*) 'eello4',ekont*eel4
7232 C---------------------------------------------------------------------------
7233 double precision function eello5(i,j,k,l,jj,kk)
7234 implicit real*8 (a-h,o-z)
7235 include 'DIMENSIONS'
7236 include 'COMMON.IOUNITS'
7237 include 'COMMON.CHAIN'
7238 include 'COMMON.DERIV'
7239 include 'COMMON.INTERACT'
7240 include 'COMMON.CONTACTS'
7241 include 'COMMON.CONTMAT'
7242 include 'COMMON.CORRMAT'
7243 include 'COMMON.TORSION'
7244 include 'COMMON.VAR'
7245 include 'COMMON.GEO'
7246 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7247 double precision ggg1(3),ggg2(3)
7248 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7253 C /l\ / \ \ / \ / \ / C
7254 C / \ / \ \ / \ / \ / C
7255 C j| o |l1 | o | o| o | | o |o C
7256 C \ |/k\| |/ \| / |/ \| |/ \| C
7257 C \i/ \ / \ / / \ / \ C
7259 C (I) (II) (III) (IV) C
7261 C eello5_1 eello5_2 eello5_3 eello5_4 C
7263 C Antiparallel chains C
7266 C /j\ / \ \ / \ / \ / C
7267 C / \ / \ \ / \ / \ / C
7268 C j1| o |l | o | o| o | | o |o C
7269 C \ |/k\| |/ \| / |/ \| |/ \| C
7270 C \i/ \ / \ / / \ / \ C
7272 C (I) (II) (III) (IV) C
7274 C eello5_1 eello5_2 eello5_3 eello5_4 C
7276 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7278 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7279 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7284 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7286 itk=itype2loc(itype(k))
7287 itl=itype2loc(itype(l))
7288 itj=itype2loc(itype(j))
7293 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7294 cd & eel5_3_num,eel5_4_num)
7298 derx(lll,kkk,iii)=0.0d0
7302 cd eij=facont_hb(jj,i)
7303 cd ekl=facont_hb(kk,k)
7305 cd write (iout,*)'Contacts have occurred for peptide groups',
7306 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7308 C Contribution from the graph I.
7309 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7310 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7311 call transpose2(EUg(1,1,k),auxmat(1,1))
7312 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7313 vv(1)=pizda(1,1)-pizda(2,2)
7314 vv(2)=pizda(1,2)+pizda(2,1)
7315 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7316 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7318 C Explicit gradient in virtual-dihedral angles.
7319 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7320 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7321 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7322 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7323 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7324 vv(1)=pizda(1,1)-pizda(2,2)
7325 vv(2)=pizda(1,2)+pizda(2,1)
7326 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7327 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7328 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7329 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7330 vv(1)=pizda(1,1)-pizda(2,2)
7331 vv(2)=pizda(1,2)+pizda(2,1)
7333 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7334 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7335 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7337 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7338 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7339 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7341 C Cartesian gradient
7345 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7347 vv(1)=pizda(1,1)-pizda(2,2)
7348 vv(2)=pizda(1,2)+pizda(2,1)
7349 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7350 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7351 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7358 C Contribution from graph II
7359 call transpose2(EE(1,1,k),auxmat(1,1))
7360 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7361 vv(1)=pizda(1,1)+pizda(2,2)
7362 vv(2)=pizda(2,1)-pizda(1,2)
7363 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7364 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7366 C Explicit gradient in virtual-dihedral angles.
7367 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7368 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7369 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7370 vv(1)=pizda(1,1)+pizda(2,2)
7371 vv(2)=pizda(2,1)-pizda(1,2)
7373 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7374 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7375 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7377 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7378 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7379 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7381 C Cartesian gradient
7385 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7387 vv(1)=pizda(1,1)+pizda(2,2)
7388 vv(2)=pizda(2,1)-pizda(1,2)
7389 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7390 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7391 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7400 C Parallel orientation
7401 C Contribution from graph III
7402 call transpose2(EUg(1,1,l),auxmat(1,1))
7403 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7404 vv(1)=pizda(1,1)-pizda(2,2)
7405 vv(2)=pizda(1,2)+pizda(2,1)
7406 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7407 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7409 C Explicit gradient in virtual-dihedral angles.
7410 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7411 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7412 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7413 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7414 vv(1)=pizda(1,1)-pizda(2,2)
7415 vv(2)=pizda(1,2)+pizda(2,1)
7416 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7417 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7418 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7419 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7420 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7421 vv(1)=pizda(1,1)-pizda(2,2)
7422 vv(2)=pizda(1,2)+pizda(2,1)
7423 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7424 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7425 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7426 C Cartesian gradient
7430 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7432 vv(1)=pizda(1,1)-pizda(2,2)
7433 vv(2)=pizda(1,2)+pizda(2,1)
7434 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7435 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7436 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7441 C Contribution from graph IV
7443 call transpose2(EE(1,1,l),auxmat(1,1))
7444 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7445 vv(1)=pizda(1,1)+pizda(2,2)
7446 vv(2)=pizda(2,1)-pizda(1,2)
7447 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7448 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7449 C Explicit gradient in virtual-dihedral angles.
7450 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7451 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7452 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7453 vv(1)=pizda(1,1)+pizda(2,2)
7454 vv(2)=pizda(2,1)-pizda(1,2)
7455 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7456 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7457 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7458 C Cartesian gradient
7462 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7464 vv(1)=pizda(1,1)+pizda(2,2)
7465 vv(2)=pizda(2,1)-pizda(1,2)
7466 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7467 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7468 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7474 C Antiparallel orientation
7475 C Contribution from graph III
7477 call transpose2(EUg(1,1,j),auxmat(1,1))
7478 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7479 vv(1)=pizda(1,1)-pizda(2,2)
7480 vv(2)=pizda(1,2)+pizda(2,1)
7481 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7482 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7484 C Explicit gradient in virtual-dihedral angles.
7485 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7486 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7487 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7488 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7489 vv(1)=pizda(1,1)-pizda(2,2)
7490 vv(2)=pizda(1,2)+pizda(2,1)
7491 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7492 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7493 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7494 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7495 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7496 vv(1)=pizda(1,1)-pizda(2,2)
7497 vv(2)=pizda(1,2)+pizda(2,1)
7498 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7499 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7500 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7501 C Cartesian gradient
7505 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7507 vv(1)=pizda(1,1)-pizda(2,2)
7508 vv(2)=pizda(1,2)+pizda(2,1)
7509 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7510 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7511 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7517 C Contribution from graph IV
7519 call transpose2(EE(1,1,j),auxmat(1,1))
7520 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7521 vv(1)=pizda(1,1)+pizda(2,2)
7522 vv(2)=pizda(2,1)-pizda(1,2)
7523 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7524 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7526 C Explicit gradient in virtual-dihedral angles.
7527 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7528 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7529 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7530 vv(1)=pizda(1,1)+pizda(2,2)
7531 vv(2)=pizda(2,1)-pizda(1,2)
7532 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7533 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7534 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7535 C Cartesian gradient
7539 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7541 vv(1)=pizda(1,1)+pizda(2,2)
7542 vv(2)=pizda(2,1)-pizda(1,2)
7543 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7544 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7545 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7552 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7553 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7554 cd write (2,*) 'ijkl',i,j,k,l
7555 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7556 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7558 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7559 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7560 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7561 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7563 if (j.lt.nres-1) then
7570 if (l.lt.nres-1) then
7580 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7581 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7582 C summed up outside the subrouine as for the other subroutines
7583 C handling long-range interactions. The old code is commented out
7584 C with "cgrad" to keep track of changes.
7586 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7587 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7588 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7589 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7590 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7591 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7592 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7593 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7594 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7595 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7597 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7598 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7599 cgrad ghalf=0.5d0*ggg1(ll)
7601 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7602 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7603 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7604 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7605 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7606 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7607 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7608 cgrad ghalf=0.5d0*ggg2(ll)
7610 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7611 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7612 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7613 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7614 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7615 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7621 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7622 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7627 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7628 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7634 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7639 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7643 cd write (2,*) iii,g_corr5_loc(iii)
7646 cd write (2,*) 'ekont',ekont
7647 cd write (iout,*) 'eello5',ekont*eel5
7650 c--------------------------------------------------------------------------
7651 double precision function eello6(i,j,k,l,jj,kk)
7652 implicit real*8 (a-h,o-z)
7653 include 'DIMENSIONS'
7654 include 'COMMON.IOUNITS'
7655 include 'COMMON.CHAIN'
7656 include 'COMMON.DERIV'
7657 include 'COMMON.INTERACT'
7658 include 'COMMON.CONTACTS'
7659 include 'COMMON.CONTMAT'
7660 include 'COMMON.CORRMAT'
7661 include 'COMMON.TORSION'
7662 include 'COMMON.VAR'
7663 include 'COMMON.GEO'
7664 include 'COMMON.FFIELD'
7665 double precision ggg1(3),ggg2(3)
7666 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7671 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7679 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7680 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7684 derx(lll,kkk,iii)=0.0d0
7688 cd eij=facont_hb(jj,i)
7689 cd ekl=facont_hb(kk,k)
7695 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7696 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7697 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7698 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7699 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7700 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7702 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7703 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7704 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7705 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7706 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7707 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7711 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7713 C If turn contributions are considered, they will be handled separately.
7714 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7715 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7716 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7717 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7718 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7719 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7720 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7723 if (j.lt.nres-1) then
7730 if (l.lt.nres-1) then
7738 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7739 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7740 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7741 cgrad ghalf=0.5d0*ggg1(ll)
7743 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7744 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7745 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7746 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7747 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7748 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7749 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7750 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7751 cgrad ghalf=0.5d0*ggg2(ll)
7752 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7754 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7755 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7756 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7757 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7758 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7759 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7765 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7766 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7771 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7772 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7778 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7783 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7787 cd write (2,*) iii,g_corr6_loc(iii)
7790 cd write (2,*) 'ekont',ekont
7791 cd write (iout,*) 'eello6',ekont*eel6
7794 c--------------------------------------------------------------------------
7795 double precision function eello6_graph1(i,j,k,l,imat,swap)
7796 implicit real*8 (a-h,o-z)
7797 include 'DIMENSIONS'
7798 include 'COMMON.IOUNITS'
7799 include 'COMMON.CHAIN'
7800 include 'COMMON.DERIV'
7801 include 'COMMON.INTERACT'
7802 include 'COMMON.CONTACTS'
7803 include 'COMMON.CONTMAT'
7804 include 'COMMON.CORRMAT'
7805 include 'COMMON.TORSION'
7806 include 'COMMON.VAR'
7807 include 'COMMON.GEO'
7808 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7812 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7814 C Parallel Antiparallel C
7820 C \ j|/k\| / \ |/k\|l / C
7825 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7826 itk=itype2loc(itype(k))
7827 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7828 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7829 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7830 call transpose2(EUgC(1,1,k),auxmat(1,1))
7831 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7832 vv1(1)=pizda1(1,1)-pizda1(2,2)
7833 vv1(2)=pizda1(1,2)+pizda1(2,1)
7834 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7835 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
7836 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
7837 s5=scalar2(vv(1),Dtobr2(1,i))
7838 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7839 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7841 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7842 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7843 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7844 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7845 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7846 & +scalar2(vv(1),Dtobr2der(1,i)))
7847 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7848 vv1(1)=pizda1(1,1)-pizda1(2,2)
7849 vv1(2)=pizda1(1,2)+pizda1(2,1)
7850 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
7851 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
7853 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7854 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7855 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7856 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7857 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7859 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7860 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7861 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7862 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7863 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7865 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7866 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7867 vv1(1)=pizda1(1,1)-pizda1(2,2)
7868 vv1(2)=pizda1(1,2)+pizda1(2,1)
7869 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7870 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7871 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7872 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7881 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7882 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7883 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7884 call transpose2(EUgC(1,1,k),auxmat(1,1))
7885 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7887 vv1(1)=pizda1(1,1)-pizda1(2,2)
7888 vv1(2)=pizda1(1,2)+pizda1(2,1)
7889 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7890 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
7891 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
7892 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
7893 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
7894 s5=scalar2(vv(1),Dtobr2(1,i))
7895 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7902 c----------------------------------------------------------------------------
7903 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7904 implicit real*8 (a-h,o-z)
7905 include 'DIMENSIONS'
7906 include 'COMMON.IOUNITS'
7907 include 'COMMON.CHAIN'
7908 include 'COMMON.DERIV'
7909 include 'COMMON.INTERACT'
7910 include 'COMMON.CONTACTS'
7911 include 'COMMON.CONTMAT'
7912 include 'COMMON.CORRMAT'
7913 include 'COMMON.TORSION'
7914 include 'COMMON.VAR'
7915 include 'COMMON.GEO'
7917 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7918 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7921 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7923 C Parallel Antiparallel C
7929 C \ j|/k\| \ |/k\|l C
7934 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7935 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7936 C AL 7/4/01 s1 would occur in the sixth-order moment,
7937 C but not in a cluster cumulant
7939 s1=dip(1,jj,i)*dip(1,kk,k)
7941 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7942 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7943 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7944 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7945 call transpose2(EUg(1,1,k),auxmat(1,1))
7946 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7947 vv(1)=pizda(1,1)-pizda(2,2)
7948 vv(2)=pizda(1,2)+pizda(2,1)
7949 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7950 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7952 eello6_graph2=-(s1+s2+s3+s4)
7954 eello6_graph2=-(s2+s3+s4)
7957 C Derivatives in gamma(i-1)
7961 s1=dipderg(1,jj,i)*dip(1,kk,k)
7963 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7964 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7965 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7966 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7968 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7970 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7972 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7974 C Derivatives in gamma(k-1)
7976 s1=dip(1,jj,i)*dipderg(1,kk,k)
7978 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7979 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7980 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7981 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7982 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7983 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7984 vv(1)=pizda(1,1)-pizda(2,2)
7985 vv(2)=pizda(1,2)+pizda(2,1)
7986 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7988 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7990 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7992 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7993 C Derivatives in gamma(j-1) or gamma(l-1)
7996 s1=dipderg(3,jj,i)*dip(1,kk,k)
7998 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7999 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8000 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8001 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8002 vv(1)=pizda(1,1)-pizda(2,2)
8003 vv(2)=pizda(1,2)+pizda(2,1)
8004 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8007 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8009 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8012 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8013 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8015 C Derivatives in gamma(l-1) or gamma(j-1)
8018 s1=dip(1,jj,i)*dipderg(3,kk,k)
8020 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8021 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8022 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8023 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8024 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8025 vv(1)=pizda(1,1)-pizda(2,2)
8026 vv(2)=pizda(1,2)+pizda(2,1)
8027 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8030 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8032 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8035 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8036 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8038 C Cartesian derivatives.
8040 write (2,*) 'In eello6_graph2'
8042 write (2,*) 'iii=',iii
8044 write (2,*) 'kkk=',kkk
8046 write (2,'(3(2f10.5),5x)')
8047 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8057 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8059 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8062 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8064 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8065 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8067 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8068 call transpose2(EUg(1,1,k),auxmat(1,1))
8069 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8071 vv(1)=pizda(1,1)-pizda(2,2)
8072 vv(2)=pizda(1,2)+pizda(2,1)
8073 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8074 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8076 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8078 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8081 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8083 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8091 c----------------------------------------------------------------------------
8092 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8093 implicit real*8 (a-h,o-z)
8094 include 'DIMENSIONS'
8095 include 'COMMON.IOUNITS'
8096 include 'COMMON.CHAIN'
8097 include 'COMMON.DERIV'
8098 include 'COMMON.INTERACT'
8099 include 'COMMON.CONTACTS'
8100 include 'COMMON.CONTMAT'
8101 include 'COMMON.CORRMAT'
8102 include 'COMMON.TORSION'
8103 include 'COMMON.VAR'
8104 include 'COMMON.GEO'
8105 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8107 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8109 C Parallel Antiparallel C
8115 C j|/k\| / |/k\|l / C
8120 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8122 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8123 C energy moment and not to the cluster cumulant.
8124 iti=itortyp(itype(i))
8125 if (j.lt.nres-1) then
8126 itj1=itype2loc(itype(j+1))
8130 itk=itype2loc(itype(k))
8131 itk1=itype2loc(itype(k+1))
8132 if (l.lt.nres-1) then
8133 itl1=itype2loc(itype(l+1))
8138 s1=dip(4,jj,i)*dip(4,kk,k)
8140 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8141 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8142 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8143 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8144 call transpose2(EE(1,1,k),auxmat(1,1))
8145 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8146 vv(1)=pizda(1,1)+pizda(2,2)
8147 vv(2)=pizda(2,1)-pizda(1,2)
8148 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8149 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8150 cd & "sum",-(s2+s3+s4)
8152 eello6_graph3=-(s1+s2+s3+s4)
8154 eello6_graph3=-(s2+s3+s4)
8157 C Derivatives in gamma(k-1)
8159 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8160 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8161 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8162 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8163 C Derivatives in gamma(l-1)
8164 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8165 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8166 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8167 vv(1)=pizda(1,1)+pizda(2,2)
8168 vv(2)=pizda(2,1)-pizda(1,2)
8169 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8170 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8171 C Cartesian derivatives.
8177 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8179 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8182 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8184 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8185 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8187 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8188 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8190 vv(1)=pizda(1,1)+pizda(2,2)
8191 vv(2)=pizda(2,1)-pizda(1,2)
8192 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8194 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8196 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8199 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8201 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8203 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8210 c----------------------------------------------------------------------------
8211 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8212 implicit real*8 (a-h,o-z)
8213 include 'DIMENSIONS'
8214 include 'COMMON.IOUNITS'
8215 include 'COMMON.CHAIN'
8216 include 'COMMON.DERIV'
8217 include 'COMMON.INTERACT'
8218 include 'COMMON.CONTACTS'
8219 include 'COMMON.CONTMAT'
8220 include 'COMMON.CORRMAT'
8221 include 'COMMON.TORSION'
8222 include 'COMMON.VAR'
8223 include 'COMMON.GEO'
8224 include 'COMMON.FFIELD'
8225 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8226 & auxvec1(2),auxmat1(2,2)
8228 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8230 C Parallel Antiparallel C
8236 C \ j|/k\| \ |/k\|l C
8241 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8243 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8244 C energy moment and not to the cluster cumulant.
8245 cd write (2,*) 'eello_graph4: wturn6',wturn6
8246 iti=itype2loc(itype(i))
8247 itj=itype2loc(itype(j))
8248 if (j.lt.nres-1) then
8249 itj1=itype2loc(itype(j+1))
8253 itk=itype2loc(itype(k))
8254 if (k.lt.nres-1) then
8255 itk1=itype2loc(itype(k+1))
8259 itl=itype2loc(itype(l))
8260 if (l.lt.nres-1) then
8261 itl1=itype2loc(itype(l+1))
8265 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8266 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8267 cd & ' itl',itl,' itl1',itl1
8270 s1=dip(3,jj,i)*dip(3,kk,k)
8272 s1=dip(2,jj,j)*dip(2,kk,l)
8275 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8276 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8278 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8279 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8281 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8282 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8284 call transpose2(EUg(1,1,k),auxmat(1,1))
8285 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8286 vv(1)=pizda(1,1)-pizda(2,2)
8287 vv(2)=pizda(2,1)+pizda(1,2)
8288 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8289 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8291 eello6_graph4=-(s1+s2+s3+s4)
8293 eello6_graph4=-(s2+s3+s4)
8295 C Derivatives in gamma(i-1)
8300 s1=dipderg(2,jj,i)*dip(3,kk,k)
8302 s1=dipderg(4,jj,j)*dip(2,kk,l)
8305 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8307 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8308 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8310 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8311 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8313 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8314 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8315 cd write (2,*) 'turn6 derivatives'
8317 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8319 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8323 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8325 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8329 C Derivatives in gamma(k-1)
8332 s1=dip(3,jj,i)*dipderg(2,kk,k)
8334 s1=dip(2,jj,j)*dipderg(4,kk,l)
8337 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8338 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8340 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8341 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8343 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8344 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8346 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8347 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8348 vv(1)=pizda(1,1)-pizda(2,2)
8349 vv(2)=pizda(2,1)+pizda(1,2)
8350 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8351 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8353 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8355 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8359 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8361 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8364 C Derivatives in gamma(j-1) or gamma(l-1)
8365 if (l.eq.j+1 .and. l.gt.1) then
8366 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8367 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8368 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8369 vv(1)=pizda(1,1)-pizda(2,2)
8370 vv(2)=pizda(2,1)+pizda(1,2)
8371 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8372 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8373 else if (j.gt.1) then
8374 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8375 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8376 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8377 vv(1)=pizda(1,1)-pizda(2,2)
8378 vv(2)=pizda(2,1)+pizda(1,2)
8379 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8380 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8381 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8383 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8386 C Cartesian derivatives.
8393 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8395 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8399 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8401 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8405 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8407 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8409 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8410 & b1(1,j+1),auxvec(1))
8411 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8413 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8414 & b1(1,l+1),auxvec(1))
8415 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8417 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8419 vv(1)=pizda(1,1)-pizda(2,2)
8420 vv(2)=pizda(2,1)+pizda(1,2)
8421 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8423 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8425 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8428 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8431 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8434 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8436 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8438 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8442 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8444 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8447 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8449 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8458 c----------------------------------------------------------------------------
8459 double precision function eello_turn6(i,jj,kk)
8460 implicit real*8 (a-h,o-z)
8461 include 'DIMENSIONS'
8462 include 'COMMON.IOUNITS'
8463 include 'COMMON.CHAIN'
8464 include 'COMMON.DERIV'
8465 include 'COMMON.INTERACT'
8466 include 'COMMON.CONTACTS'
8467 include 'COMMON.CONTMAT'
8468 include 'COMMON.CORRMAT'
8469 include 'COMMON.TORSION'
8470 include 'COMMON.VAR'
8471 include 'COMMON.GEO'
8472 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8473 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8475 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8476 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8477 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8478 C the respective energy moment and not to the cluster cumulant.
8487 iti=itype2loc(itype(i))
8488 itk=itype2loc(itype(k))
8489 itk1=itype2loc(itype(k+1))
8490 itl=itype2loc(itype(l))
8491 itj=itype2loc(itype(j))
8492 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8493 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8494 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8499 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8501 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8505 derx_turn(lll,kkk,iii)=0.0d0
8512 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8514 cd write (2,*) 'eello6_5',eello6_5
8516 call transpose2(AEA(1,1,1),auxmat(1,1))
8517 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8518 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8519 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8521 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8522 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8523 s2 = scalar2(b1(1,k),vtemp1(1))
8525 call transpose2(AEA(1,1,2),atemp(1,1))
8526 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8527 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8528 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8530 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8531 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8532 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8534 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8535 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8536 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8537 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8538 ss13 = scalar2(b1(1,k),vtemp4(1))
8539 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8541 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8547 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8548 C Derivatives in gamma(i+2)
8553 call transpose2(AEA(1,1,1),auxmatd(1,1))
8554 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8555 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8556 call transpose2(AEAderg(1,1,2),atempd(1,1))
8557 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8558 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8560 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8561 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8562 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8568 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8569 C Derivatives in gamma(i+3)
8571 call transpose2(AEA(1,1,1),auxmatd(1,1))
8572 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8573 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8574 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8576 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8577 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8578 s2d = scalar2(b1(1,k),vtemp1d(1))
8580 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8581 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8583 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8585 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8586 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8587 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8595 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8596 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8598 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8599 & -0.5d0*ekont*(s2d+s12d)
8601 C Derivatives in gamma(i+4)
8602 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8603 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8604 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8606 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8607 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8608 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8616 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8618 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8620 C Derivatives in gamma(i+5)
8622 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8623 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8624 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8626 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8627 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8628 s2d = scalar2(b1(1,k),vtemp1d(1))
8630 call transpose2(AEA(1,1,2),atempd(1,1))
8631 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8632 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8634 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8635 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8637 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8638 ss13d = scalar2(b1(1,k),vtemp4d(1))
8639 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8647 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8648 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8650 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8651 & -0.5d0*ekont*(s2d+s12d)
8653 C Cartesian derivatives
8658 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8659 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8660 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8662 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8663 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8665 s2d = scalar2(b1(1,k),vtemp1d(1))
8667 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8668 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8669 s8d = -(atempd(1,1)+atempd(2,2))*
8670 & scalar2(cc(1,1,l),vtemp2(1))
8672 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8674 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8675 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8682 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8685 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8689 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8690 & - 0.5d0*(s8d+s12d)
8692 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8701 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8703 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8704 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8705 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8706 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8707 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8709 ss13d = scalar2(b1(1,k),vtemp4d(1))
8710 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8711 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8715 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8716 cd & 16*eel_turn6_num
8718 if (j.lt.nres-1) then
8725 if (l.lt.nres-1) then
8733 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8734 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8735 cgrad ghalf=0.5d0*ggg1(ll)
8737 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8738 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8739 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8740 & +ekont*derx_turn(ll,2,1)
8741 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8742 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8743 & +ekont*derx_turn(ll,4,1)
8744 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8745 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8746 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8747 cgrad ghalf=0.5d0*ggg2(ll)
8749 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8750 & +ekont*derx_turn(ll,2,2)
8751 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8752 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8753 & +ekont*derx_turn(ll,4,2)
8754 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8755 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8756 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8761 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8766 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8772 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8777 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8781 cd write (2,*) iii,g_corr6_loc(iii)
8784 eello_turn6=ekont*eel_turn6
8785 cd write (2,*) 'ekont',ekont
8786 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8790 crc-------------------------------------------------
8791 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8792 subroutine Eliptransfer(eliptran)
8793 implicit real*8 (a-h,o-z)
8794 include 'DIMENSIONS'
8795 include 'COMMON.GEO'
8796 include 'COMMON.VAR'
8797 include 'COMMON.LOCAL'
8798 include 'COMMON.CHAIN'
8799 include 'COMMON.DERIV'
8800 include 'COMMON.INTERACT'
8801 include 'COMMON.IOUNITS'
8802 include 'COMMON.CALC'
8803 include 'COMMON.CONTROL'
8804 include 'COMMON.SPLITELE'
8805 include 'COMMON.SBRIDGE'
8806 C this is done by Adasko
8810 C--bordliptop-- buffore starts
8811 C--bufliptop--- here true lipid starts
8813 C--buflipbot--- lipid ends buffore starts
8814 C--bordlipbot--buffore ends
8818 if (itype(i).eq.ntyp1) cycle
8820 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8821 if (positi.le.0) positi=positi+boxzsize
8823 C first for peptide groups
8824 c for each residue check if it is in lipid or lipid water border area
8825 if ((positi.gt.bordlipbot)
8826 &.and.(positi.lt.bordliptop)) then
8827 C the energy transfer exist
8828 if (positi.lt.buflipbot) then
8829 C what fraction I am in
8831 & ((positi-bordlipbot)/lipbufthick)
8832 C lipbufthick is thickenes of lipid buffore
8833 sslip=sscalelip(fracinbuf)
8834 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8835 eliptran=eliptran+sslip*pepliptran
8836 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8837 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8838 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8839 elseif (positi.gt.bufliptop) then
8840 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8841 sslip=sscalelip(fracinbuf)
8842 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8843 eliptran=eliptran+sslip*pepliptran
8844 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8845 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8846 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8847 C print *, "doing sscalefor top part"
8848 C print *,i,sslip,fracinbuf,ssgradlip
8850 eliptran=eliptran+pepliptran
8851 C print *,"I am in true lipid"
8854 C eliptran=elpitran+0.0 ! I am in water
8857 C print *, "nic nie bylo w lipidzie?"
8858 C now multiply all by the peptide group transfer factor
8859 C eliptran=eliptran*pepliptran
8860 C now the same for side chains
8863 if (itype(i).eq.ntyp1) cycle
8864 positi=(mod(c(3,i+nres),boxzsize))
8865 if (positi.le.0) positi=positi+boxzsize
8866 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8867 c for each residue check if it is in lipid or lipid water border area
8868 C respos=mod(c(3,i+nres),boxzsize)
8869 C print *,positi,bordlipbot,buflipbot
8870 if ((positi.gt.bordlipbot)
8871 & .and.(positi.lt.bordliptop)) then
8872 C the energy transfer exist
8873 if (positi.lt.buflipbot) then
8875 & ((positi-bordlipbot)/lipbufthick)
8876 C lipbufthick is thickenes of lipid buffore
8877 sslip=sscalelip(fracinbuf)
8878 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8879 eliptran=eliptran+sslip*liptranene(itype(i))
8880 gliptranx(3,i)=gliptranx(3,i)
8881 &+ssgradlip*liptranene(itype(i))
8882 gliptranc(3,i-1)= gliptranc(3,i-1)
8883 &+ssgradlip*liptranene(itype(i))
8884 C print *,"doing sccale for lower part"
8885 elseif (positi.gt.bufliptop) then
8887 &((bordliptop-positi)/lipbufthick)
8888 sslip=sscalelip(fracinbuf)
8889 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8890 eliptran=eliptran+sslip*liptranene(itype(i))
8891 gliptranx(3,i)=gliptranx(3,i)
8892 &+ssgradlip*liptranene(itype(i))
8893 gliptranc(3,i-1)= gliptranc(3,i-1)
8894 &+ssgradlip*liptranene(itype(i))
8895 C print *, "doing sscalefor top part",sslip,fracinbuf
8897 eliptran=eliptran+liptranene(itype(i))
8898 C print *,"I am in true lipid"
8900 endif ! if in lipid or buffor
8902 C eliptran=elpitran+0.0 ! I am in water
8908 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8910 SUBROUTINE MATVEC2(A1,V1,V2)
8911 implicit real*8 (a-h,o-z)
8912 include 'DIMENSIONS'
8913 DIMENSION A1(2,2),V1(2),V2(2)
8917 c 3 VI=VI+A1(I,K)*V1(K)
8921 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8922 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8927 C---------------------------------------
8928 SUBROUTINE MATMAT2(A1,A2,A3)
8929 implicit real*8 (a-h,o-z)
8930 include 'DIMENSIONS'
8931 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8932 c DIMENSION AI3(2,2)
8936 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8942 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8943 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8944 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8945 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8953 c-------------------------------------------------------------------------
8954 double precision function scalar2(u,v)
8956 double precision u(2),v(2)
8959 scalar2=u(1)*v(1)+u(2)*v(2)
8963 C-----------------------------------------------------------------------------
8965 subroutine transpose2(a,at)
8967 double precision a(2,2),at(2,2)
8974 c--------------------------------------------------------------------------
8975 subroutine transpose(n,a,at)
8978 double precision a(n,n),at(n,n)
8986 C---------------------------------------------------------------------------
8987 subroutine prodmat3(a1,a2,kk,transp,prod)
8990 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8992 crc double precision auxmat(2,2),prod_(2,2)
8995 crc call transpose2(kk(1,1),auxmat(1,1))
8996 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8997 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8999 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9000 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9001 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9002 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9003 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9004 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9005 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9006 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9009 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9010 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9012 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9013 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9014 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9015 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9016 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9017 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9018 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9019 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9022 c call transpose2(a2(1,1),a2t(1,1))
9025 crc print *,((prod_(i,j),i=1,2),j=1,2)
9026 crc print *,((prod(i,j),i=1,2),j=1,2)
9030 C-----------------------------------------------------------------------------
9031 double precision function scalar(u,v)
9033 double precision u(3),v(3)
9043 C-----------------------------------------------------------------------
9044 double precision function sscale(r)
9045 double precision r,gamm
9046 include "COMMON.SPLITELE"
9047 if(r.lt.r_cut-rlamb) then
9049 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9050 gamm=(r-(r_cut-rlamb))/rlamb
9051 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9057 C-----------------------------------------------------------------------
9058 C-----------------------------------------------------------------------
9059 double precision function sscagrad(r)
9060 double precision r,gamm
9061 include "COMMON.SPLITELE"
9062 if(r.lt.r_cut-rlamb) then
9064 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9065 gamm=(r-(r_cut-rlamb))/rlamb
9066 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9072 C-----------------------------------------------------------------------
9073 C-----------------------------------------------------------------------
9074 double precision function sscalelip(r)
9075 double precision r,gamm
9076 include "COMMON.SPLITELE"
9077 C if(r.lt.r_cut-rlamb) then
9079 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9080 C gamm=(r-(r_cut-rlamb))/rlamb
9081 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9087 C-----------------------------------------------------------------------
9088 double precision function sscagradlip(r)
9089 double precision r,gamm
9090 include "COMMON.SPLITELE"
9091 C if(r.lt.r_cut-rlamb) then
9093 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9094 C gamm=(r-(r_cut-rlamb))/rlamb
9095 sscagradlip=r*(6*r-6.0d0)
9102 C-----------------------------------------------------------------------
9103 subroutine set_shield_fac
9104 implicit real*8 (a-h,o-z)
9105 include 'DIMENSIONS'
9106 include 'COMMON.CHAIN'
9107 include 'COMMON.DERIV'
9108 include 'COMMON.IOUNITS'
9109 include 'COMMON.SHIELD'
9110 include 'COMMON.INTERACT'
9111 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9112 double precision div77_81/0.974996043d0/,
9113 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9115 C the vector between center of side_chain and peptide group
9116 double precision pep_side(3),long,side_calf(3),
9117 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9118 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9119 C the line belowe needs to be changed for FGPROC>1
9121 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9123 Cif there two consequtive dummy atoms there is no peptide group between them
9124 C the line below has to be changed for FGPROC>1
9127 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9131 C first lets set vector conecting the ithe side-chain with kth side-chain
9132 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9134 C and vector conecting the side-chain with its proper calfa
9135 side_calf(j)=c(j,k+nres)-c(j,k)
9136 C side_calf(j)=2.0d0
9137 pept_group(j)=c(j,i)-c(j,i+1)
9138 C lets have their lenght
9139 dist_pep_side=pep_side(j)**2+dist_pep_side
9140 dist_side_calf=dist_side_calf+side_calf(j)**2
9141 dist_pept_group=dist_pept_group+pept_group(j)**2
9143 dist_pep_side=dsqrt(dist_pep_side)
9144 dist_pept_group=dsqrt(dist_pept_group)
9145 dist_side_calf=dsqrt(dist_side_calf)
9147 pep_side_norm(j)=pep_side(j)/dist_pep_side
9148 side_calf_norm(j)=dist_side_calf
9150 C now sscale fraction
9151 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9152 C print *,buff_shield,"buff"
9154 if (sh_frac_dist.le.0.0) cycle
9155 C If we reach here it means that this side chain reaches the shielding sphere
9156 C Lets add him to the list for gradient
9157 ishield_list(i)=ishield_list(i)+1
9158 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9159 C this list is essential otherwise problem would be O3
9160 shield_list(ishield_list(i),i)=k
9161 C Lets have the sscale value
9162 if (sh_frac_dist.gt.1.0) then
9163 scale_fac_dist=1.0d0
9165 sh_frac_dist_grad(j)=0.0d0
9168 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9169 & *(2.0*sh_frac_dist-3.0d0)
9170 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9171 & /dist_pep_side/buff_shield*0.5
9172 C remember for the final gradient multiply sh_frac_dist_grad(j)
9173 C for side_chain by factor -2 !
9175 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9176 C print *,"jestem",scale_fac_dist,fac_help_scale,
9177 C & sh_frac_dist_grad(j)
9180 C if ((i.eq.3).and.(k.eq.2)) then
9181 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9185 C this is what is now we have the distance scaling now volume...
9186 short=short_r_sidechain(itype(k))
9187 long=long_r_sidechain(itype(k))
9188 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9191 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9194 costhet_grad(j)=costhet_fac*pep_side(j)
9196 C remember for the final gradient multiply costhet_grad(j)
9197 C for side_chain by factor -2 !
9198 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9199 C pep_side0pept_group is vector multiplication
9200 pep_side0pept_group=0.0
9202 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9204 cosalfa=(pep_side0pept_group/
9205 & (dist_pep_side*dist_side_calf))
9206 fac_alfa_sin=1.0-cosalfa**2
9207 fac_alfa_sin=dsqrt(fac_alfa_sin)
9208 rkprim=fac_alfa_sin*(long-short)+short
9210 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9211 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9214 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9215 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9216 &*(long-short)/fac_alfa_sin*cosalfa/
9217 &((dist_pep_side*dist_side_calf))*
9218 &((side_calf(j))-cosalfa*
9219 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9221 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9222 &*(long-short)/fac_alfa_sin*cosalfa
9223 &/((dist_pep_side*dist_side_calf))*
9225 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9228 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9231 C now the gradient...
9232 C grad_shield is gradient of Calfa for peptide groups
9233 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9235 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9236 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9238 grad_shield(j,i)=grad_shield(j,i)
9239 C gradient po skalowaniu
9240 & +(sh_frac_dist_grad(j)
9241 C gradient po costhet
9242 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9243 &-scale_fac_dist*(cosphi_grad_long(j))
9244 &/(1.0-cosphi) )*div77_81
9246 C grad_shield_side is Cbeta sidechain gradient
9247 grad_shield_side(j,ishield_list(i),i)=
9248 & (sh_frac_dist_grad(j)*(-2.0d0)
9249 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9250 & +scale_fac_dist*(cosphi_grad_long(j))
9251 & *2.0d0/(1.0-cosphi))
9252 & *div77_81*VofOverlap
9254 grad_shield_loc(j,ishield_list(i),i)=
9255 & scale_fac_dist*cosphi_grad_loc(j)
9256 & *2.0d0/(1.0-cosphi)
9257 & *div77_81*VofOverlap
9259 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9261 fac_shield(i)=VolumeTotal*div77_81+div4_81
9262 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9266 C--------------------------------------------------------------------------
9267 C first for shielding is setting of function of side-chains
9268 subroutine set_shield_fac2
9269 implicit real*8 (a-h,o-z)
9270 include 'DIMENSIONS'
9271 include 'COMMON.CHAIN'
9272 include 'COMMON.DERIV'
9273 include 'COMMON.IOUNITS'
9274 include 'COMMON.SHIELD'
9275 include 'COMMON.INTERACT'
9276 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9277 double precision div77_81/0.974996043d0/,
9278 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9280 C the vector between center of side_chain and peptide group
9281 double precision pep_side(3),long,side_calf(3),
9282 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9283 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9284 C the line belowe needs to be changed for FGPROC>1
9286 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9288 Cif there two consequtive dummy atoms there is no peptide group between them
9289 C the line below has to be changed for FGPROC>1
9292 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9296 C first lets set vector conecting the ithe side-chain with kth side-chain
9297 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9299 C and vector conecting the side-chain with its proper calfa
9300 side_calf(j)=c(j,k+nres)-c(j,k)
9301 C side_calf(j)=2.0d0
9302 pept_group(j)=c(j,i)-c(j,i+1)
9303 C lets have their lenght
9304 dist_pep_side=pep_side(j)**2+dist_pep_side
9305 dist_side_calf=dist_side_calf+side_calf(j)**2
9306 dist_pept_group=dist_pept_group+pept_group(j)**2
9308 dist_pep_side=dsqrt(dist_pep_side)
9309 dist_pept_group=dsqrt(dist_pept_group)
9310 dist_side_calf=dsqrt(dist_side_calf)
9312 pep_side_norm(j)=pep_side(j)/dist_pep_side
9313 side_calf_norm(j)=dist_side_calf
9315 C now sscale fraction
9316 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9317 C print *,buff_shield,"buff"
9319 if (sh_frac_dist.le.0.0) cycle
9320 C If we reach here it means that this side chain reaches the shielding sphere
9321 C Lets add him to the list for gradient
9322 ishield_list(i)=ishield_list(i)+1
9323 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9324 C this list is essential otherwise problem would be O3
9325 shield_list(ishield_list(i),i)=k
9326 C Lets have the sscale value
9327 if (sh_frac_dist.gt.1.0) then
9328 scale_fac_dist=1.0d0
9330 sh_frac_dist_grad(j)=0.0d0
9333 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9334 & *(2.0d0*sh_frac_dist-3.0d0)
9335 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9336 & /dist_pep_side/buff_shield*0.5d0
9337 C remember for the final gradient multiply sh_frac_dist_grad(j)
9338 C for side_chain by factor -2 !
9340 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9341 C sh_frac_dist_grad(j)=0.0d0
9342 C scale_fac_dist=1.0d0
9343 C print *,"jestem",scale_fac_dist,fac_help_scale,
9344 C & sh_frac_dist_grad(j)
9347 C this is what is now we have the distance scaling now volume...
9348 short=short_r_sidechain(itype(k))
9349 long=long_r_sidechain(itype(k))
9350 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9351 sinthet=short/dist_pep_side*costhet
9355 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9356 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9357 C & -short/dist_pep_side**2/costhet)
9360 costhet_grad(j)=costhet_fac*pep_side(j)
9362 C remember for the final gradient multiply costhet_grad(j)
9363 C for side_chain by factor -2 !
9364 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9365 C pep_side0pept_group is vector multiplication
9366 pep_side0pept_group=0.0d0
9368 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9370 cosalfa=(pep_side0pept_group/
9371 & (dist_pep_side*dist_side_calf))
9372 fac_alfa_sin=1.0d0-cosalfa**2
9373 fac_alfa_sin=dsqrt(fac_alfa_sin)
9374 rkprim=fac_alfa_sin*(long-short)+short
9378 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9380 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9381 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9385 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9386 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9387 &*(long-short)/fac_alfa_sin*cosalfa/
9388 &((dist_pep_side*dist_side_calf))*
9389 &((side_calf(j))-cosalfa*
9390 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9391 C cosphi_grad_long(j)=0.0d0
9392 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9393 &*(long-short)/fac_alfa_sin*cosalfa
9394 &/((dist_pep_side*dist_side_calf))*
9396 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9397 C cosphi_grad_loc(j)=0.0d0
9399 C print *,sinphi,sinthet
9400 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9403 C now the gradient...
9405 grad_shield(j,i)=grad_shield(j,i)
9406 C gradient po skalowaniu
9407 & +(sh_frac_dist_grad(j)*VofOverlap
9408 C gradient po costhet
9409 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9410 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9411 & sinphi/sinthet*costhet*costhet_grad(j)
9412 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9414 C grad_shield_side is Cbeta sidechain gradient
9415 grad_shield_side(j,ishield_list(i),i)=
9416 & (sh_frac_dist_grad(j)*(-2.0d0)
9418 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9419 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9420 & sinphi/sinthet*costhet*costhet_grad(j)
9421 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9424 grad_shield_loc(j,ishield_list(i),i)=
9425 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9426 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9427 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9431 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9433 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9434 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9435 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9439 C--------------------------------------------------------------------------
9440 double precision function tschebyshev(m,n,x,y)
9442 include "DIMENSIONS"
9444 double precision x(n),y,yy(0:maxvar),aux
9445 c Tschebyshev polynomial. Note that the first term is omitted
9446 c m=0: the constant term is included
9447 c m=1: the constant term is not included
9451 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9460 C--------------------------------------------------------------------------
9461 double precision function gradtschebyshev(m,n,x,y)
9463 include "DIMENSIONS"
9465 double precision x(n+1),y,yy(0:maxvar),aux
9466 c Tschebyshev polynomial. Note that the first term is omitted
9467 c m=0: the constant term is included
9468 c m=1: the constant term is not included
9472 yy(i)=2*y*yy(i-1)-yy(i-2)
9476 aux=aux+x(i+1)*yy(i)*(i+1)
9477 C print *, x(i+1),yy(i),i
9482 c----------------------------------------------------------------------------
9483 double precision function sscale2(r,r_cut,r0,rlamb)
9485 double precision r,gamm,r_cut,r0,rlamb,rr
9487 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9488 c write (2,*) "rr",rr
9489 if(rr.lt.r_cut-rlamb) then
9491 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9492 gamm=(rr-(r_cut-rlamb))/rlamb
9493 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9499 C-----------------------------------------------------------------------
9500 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9502 double precision r,gamm,r_cut,r0,rlamb,rr
9504 if(rr.lt.r_cut-rlamb) then
9506 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9507 gamm=(rr-(r_cut-rlamb))/rlamb
9509 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9511 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9518 c----------------------------------------------------------------------------
9519 subroutine e_saxs(Esaxs_constr)
9521 include 'DIMENSIONS'
9524 include "COMMON.SETUP"
9527 include 'COMMON.SBRIDGE'
9528 include 'COMMON.CHAIN'
9529 include 'COMMON.GEO'
9530 include 'COMMON.LOCAL'
9531 include 'COMMON.INTERACT'
9532 include 'COMMON.VAR'
9533 include 'COMMON.IOUNITS'
9534 include 'COMMON.DERIV'
9535 include 'COMMON.CONTROL'
9536 include 'COMMON.NAMES'
9537 include 'COMMON.FFIELD'
9538 include 'COMMON.LANGEVIN'
9539 include 'COMMON.SAXS'
9541 double precision Esaxs_constr
9542 integer i,iint,j,k,l
9543 double precision PgradC(maxSAXS,3,maxres),
9544 & PgradX(maxSAXS,3,maxres)
9546 double precision PgradC_(maxSAXS,3,maxres),
9547 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9549 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9550 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9551 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9552 & auxX,auxX1,CACAgrad,Cnorm
9553 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9554 double precision dist
9556 c SAXS restraint penalty function
9558 write(iout,*) "------- SAXS penalty function start -------"
9559 write (iout,*) "nsaxs",nsaxs
9560 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9561 write (iout,*) "Psaxs"
9563 write (iout,'(i5,e15.5)') i, Psaxs(i)
9566 Esaxs_constr = 0.0d0
9576 do i=iatsc_s,iatsc_e
9577 if (itype(i).eq.ntyp1) cycle
9578 do iint=1,nint_gr(i)
9579 do j=istart(i,iint),iend(i,iint)
9580 if (itype(j).eq.ntyp1) cycle
9583 dijCASC=dist(i,j+nres)
9584 dijSCCA=dist(i+nres,j)
9585 dijSCSC=dist(i+nres,j+nres)
9586 sigma2CACA=2.0d0/(pstok**2)
9587 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9588 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9589 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9592 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9593 if (itype(j).ne.10) then
9594 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9598 if (itype(i).ne.10) then
9599 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9603 if (itype(i).ne.10 .and. itype(j).ne.10) then
9604 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9608 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9610 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9612 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9613 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9614 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9615 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9618 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9619 PgradC(k,l,i) = PgradC(k,l,i)-aux
9620 PgradC(k,l,j) = PgradC(k,l,j)+aux
9622 if (itype(j).ne.10) then
9623 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9624 PgradC(k,l,i) = PgradC(k,l,i)-aux
9625 PgradC(k,l,j) = PgradC(k,l,j)+aux
9626 PgradX(k,l,j) = PgradX(k,l,j)+aux
9629 if (itype(i).ne.10) then
9630 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9631 PgradX(k,l,i) = PgradX(k,l,i)-aux
9632 PgradC(k,l,i) = PgradC(k,l,i)-aux
9633 PgradC(k,l,j) = PgradC(k,l,j)+aux
9636 if (itype(i).ne.10 .and. itype(j).ne.10) then
9637 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9638 PgradC(k,l,i) = PgradC(k,l,i)-aux
9639 PgradC(k,l,j) = PgradC(k,l,j)+aux
9640 PgradX(k,l,i) = PgradX(k,l,i)-aux
9641 PgradX(k,l,j) = PgradX(k,l,j)+aux
9647 sigma2CACA=scal_rad**2*0.25d0/
9648 & (restok(itype(j))**2+restok(itype(i))**2)
9650 IF (saxs_cutoff.eq.0) THEN
9653 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9654 Pcalc(k) = Pcalc(k)+expCACA
9655 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9657 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9658 PgradC(k,l,i) = PgradC(k,l,i)-aux
9659 PgradC(k,l,j) = PgradC(k,l,j)+aux
9663 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9666 c write (2,*) "ijk",i,j,k
9667 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9668 if (sss2.eq.0.0d0) cycle
9669 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9670 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9671 Pcalc(k) = Pcalc(k)+expCACA
9673 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9675 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9676 & ssgrad2*expCACA/sss2
9679 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9680 PgradC(k,l,i) = PgradC(k,l,i)+aux
9681 PgradC(k,l,j) = PgradC(k,l,j)-aux
9690 if (nfgtasks.gt.1) then
9691 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9692 & MPI_SUM,king,FG_COMM,IERR)
9693 if (fg_rank.eq.king) then
9695 Pcalc(k) = Pcalc_(k)
9698 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9699 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9700 if (fg_rank.eq.king) then
9704 PgradC(k,l,i) = PgradC_(k,l,i)
9710 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9711 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9712 if (fg_rank.eq.king) then
9716 PgradX(k,l,i) = PgradX_(k,l,i)
9725 if (fg_rank.eq.king) then
9729 Cnorm = Cnorm + Pcalc(k)
9731 Esaxs_constr = dlog(Cnorm)-wsaxs0
9733 if (Pcalc(k).gt.0.0d0)
9734 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9736 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9740 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9750 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9751 auxC1 = auxC1+PgradC(k,l,i)
9753 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9754 auxX1 = auxX1+PgradX(k,l,i)
9757 gsaxsC(l,i) = auxC - auxC1/Cnorm
9759 gsaxsX(l,i) = auxX - auxX1/Cnorm
9761 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9762 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9770 c----------------------------------------------------------------------------
9771 subroutine e_saxsC(Esaxs_constr)
9773 include 'DIMENSIONS'
9776 include "COMMON.SETUP"
9779 include 'COMMON.SBRIDGE'
9780 include 'COMMON.CHAIN'
9781 include 'COMMON.GEO'
9782 include 'COMMON.LOCAL'
9783 include 'COMMON.INTERACT'
9784 include 'COMMON.VAR'
9785 include 'COMMON.IOUNITS'
9786 include 'COMMON.DERIV'
9787 include 'COMMON.CONTROL'
9788 include 'COMMON.NAMES'
9789 include 'COMMON.FFIELD'
9790 include 'COMMON.LANGEVIN'
9791 include 'COMMON.SAXS'
9793 double precision Esaxs_constr
9794 integer i,iint,j,k,l
9795 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc_,logPtot
9797 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9799 double precision dk,dijCASPH,dijSCSPH,
9800 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9801 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
9803 c SAXS restraint penalty function
9805 write(iout,*) "------- SAXS penalty function start -------"
9806 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
9807 & " isaxs_end",isaxs_end
9808 write (iout,*) "nnt",nnt," ntc",nct
9810 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9811 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9814 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9817 Esaxs_constr = 0.0d0
9819 do j=isaxs_start,isaxs_end
9831 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9833 if (itype(i).ne.10) then
9835 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9838 sigma2CA=2.0d0/pstok**2
9839 sigma2SC=4.0d0/restok(itype(i))**2
9840 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9841 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9842 Pcalc_ = Pcalc_+expCASPH+expSCSPH
9844 write(*,*) "processor i j Pcalc",
9845 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc_
9847 CASPHgrad = sigma2CA*expCASPH
9848 SCSPHgrad = sigma2SC*expSCSPH
9850 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9851 PgradX(l,i) = PgradX(l,i) + aux
9852 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9857 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc_
9858 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc_
9861 logPtot = logPtot - dlog(Pcalc_)
9862 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc_),
9863 c & " logPtot",logPtot
9866 if (nfgtasks.gt.1) then
9867 c write (iout,*) "logPtot before reduction",logPtot
9868 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9869 & MPI_SUM,king,FG_COMM,IERR)
9871 c write (iout,*) "logPtot after reduction",logPtot
9872 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9873 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9874 if (fg_rank.eq.king) then
9877 gsaxsC(l,i) = gsaxsC_(l,i)
9881 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9882 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9883 if (fg_rank.eq.king) then
9886 gsaxsX(l,i) = gsaxsX_(l,i)
9892 Esaxs_constr = logPtot
9895 C--------------------------------------------------------------------------
9896 c MODELLER restraint function
9897 subroutine e_modeller(ehomology_constr)
9898 implicit real*8 (a-h,o-z)
9899 include 'DIMENSIONS'
9900 integer nnn, i, j, k, ki, irec, l
9901 integer katy, odleglosci, test7
9902 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
9903 real*8 distance(max_template),distancek(max_template),
9904 & min_odl,godl(max_template),dih_diff(max_template)
9907 c FP - 30/10/2014 Temporary specifications for homology restraints
9909 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
9911 double precision, dimension (maxres) :: guscdiff,usc_diff
9912 double precision, dimension (max_template) ::
9913 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
9916 include 'COMMON.SBRIDGE'
9917 include 'COMMON.CHAIN'
9918 include 'COMMON.GEO'
9919 include 'COMMON.DERIV'
9920 include 'COMMON.LOCAL'
9921 include 'COMMON.INTERACT'
9922 include 'COMMON.VAR'
9923 include 'COMMON.IOUNITS'
9924 include 'COMMON.CONTROL'
9925 include 'COMMON.HOMRESTR'
9926 include 'COMMON.HOMOLOGY'
9927 include 'COMMON.SETUP'
9928 include 'COMMON.NAMES'
9931 distancek(i)=9999999.9
9936 c Pseudo-energy and gradient from homology restraints (MODELLER-like
9938 C AL 5/2/14 - Introduce list of restraints
9939 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
9941 write(iout,*) "------- dist restrs start -------"
9943 do ii = link_start_homo,link_end_homo
9947 c write (iout,*) "dij(",i,j,") =",dij
9949 do k=1,constr_homology
9950 if(.not.l_homo(k,ii)) then
9954 distance(k)=odl(k,ii)-dij
9955 c write (iout,*) "distance(",k,") =",distance(k)
9957 c For Gaussian-type Urestr
9959 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
9960 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
9961 c write (iout,*) "distancek(",k,") =",distancek(k)
9962 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
9964 c For Lorentzian-type Urestr
9966 if (waga_dist.lt.0.0d0) then
9967 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
9968 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
9969 & (distance(k)**2+sigma_odlir(k,ii)**2))
9973 c min_odl=minval(distancek)
9977 do kk=1,constr_homology
9978 if(l_homo(kk,ii)) then
9979 min_odl=distancek(kk)
9983 do kk=1,constr_homology
9984 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
9985 & min_odl=distancek(kk)
9988 c write (iout,* )"min_odl",min_odl
9990 write (iout,*) "ij dij",i,j,dij
9991 write (iout,*) "distance",(distance(k),k=1,constr_homology)
9992 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
9993 write (iout,* )"min_odl",min_odl
9998 if (waga_dist.ge.0.0d0) then
10004 do k=1,constr_homology
10005 c Nie wiem po co to liczycie jeszcze raz!
10006 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
10007 c & (2*(sigma_odl(i,j,k))**2))
10008 if(.not.l_homo(k,ii)) cycle
10009 if (waga_dist.ge.0.0d0) then
10011 c For Gaussian-type Urestr
10013 godl(k)=dexp(-distancek(k)+min_odl)
10014 odleg2=odleg2+godl(k)
10016 c For Lorentzian-type Urestr
10019 odleg2=odleg2+distancek(k)
10022 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
10023 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
10024 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
10025 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
10028 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10029 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10031 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10032 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10034 if (waga_dist.ge.0.0d0) then
10036 c For Gaussian-type Urestr
10038 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
10040 c For Lorentzian-type Urestr
10043 odleg=odleg+odleg2/constr_homology
10047 c write (iout,*) "odleg",odleg ! sum of -ln-s
10050 c For Gaussian-type Urestr
10052 if (waga_dist.ge.0.0d0) sum_godl=odleg2
10054 do k=1,constr_homology
10055 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10056 c & *waga_dist)+min_odl
10057 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
10059 if(.not.l_homo(k,ii)) cycle
10060 if (waga_dist.ge.0.0d0) then
10061 c For Gaussian-type Urestr
10063 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
10065 c For Lorentzian-type Urestr
10068 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
10069 & sigma_odlir(k,ii)**2)**2)
10071 sum_sgodl=sum_sgodl+sgodl
10073 c sgodl2=sgodl2+sgodl
10074 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
10075 c write(iout,*) "constr_homology=",constr_homology
10076 c write(iout,*) i, j, k, "TEST K"
10078 if (waga_dist.ge.0.0d0) then
10080 c For Gaussian-type Urestr
10082 grad_odl3=waga_homology(iset)*waga_dist
10083 & *sum_sgodl/(sum_godl*dij)
10085 c For Lorentzian-type Urestr
10088 c Original grad expr modified by analogy w Gaussian-type Urestr grad
10089 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
10090 grad_odl3=-waga_homology(iset)*waga_dist*
10091 & sum_sgodl/(constr_homology*dij)
10094 c grad_odl3=sum_sgodl/(sum_godl*dij)
10097 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
10098 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
10099 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10101 ccc write(iout,*) godl, sgodl, grad_odl3
10103 c grad_odl=grad_odl+grad_odl3
10106 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
10107 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
10108 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
10109 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10110 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
10111 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
10112 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
10113 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10114 c if (i.eq.25.and.j.eq.27) then
10115 c write(iout,*) "jik",jik,"i",i,"j",j
10116 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
10117 c write(iout,*) "grad_odl3",grad_odl3
10118 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
10119 c write(iout,*) "ggodl",ggodl
10120 c write(iout,*) "ghpbc(",jik,i,")",
10121 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
10126 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
10127 ccc & dLOG(odleg2),"-odleg=", -odleg
10129 enddo ! ii-loop for dist
10131 write(iout,*) "------- dist restrs end -------"
10132 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
10133 c & waga_d.eq.1.0d0) call sum_gradient
10135 c Pseudo-energy and gradient from dihedral-angle restraints from
10136 c homology templates
10137 c write (iout,*) "End of distance loop"
10140 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
10142 write(iout,*) "------- dih restrs start -------"
10143 do i=idihconstr_start_homo,idihconstr_end_homo
10144 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
10147 do i=idihconstr_start_homo,idihconstr_end_homo
10149 c betai=beta(i,i+1,i+2,i+3)
10151 c write (iout,*) "betai =",betai
10152 do k=1,constr_homology
10153 dih_diff(k)=pinorm(dih(k,i)-betai)
10154 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
10155 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
10156 c & -(6.28318-dih_diff(i,k))
10157 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
10158 c & 6.28318+dih_diff(i,k)
10160 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
10162 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
10164 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
10167 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
10170 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
10171 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
10173 write (iout,*) "i",i," betai",betai," kat2",kat2
10174 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
10176 if (kat2.le.1.0d-14) cycle
10177 kat=kat-dLOG(kat2/constr_homology)
10178 c write (iout,*) "kat",kat ! sum of -ln-s
10180 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
10181 ccc & dLOG(kat2), "-kat=", -kat
10184 c ----------------------------------------------------------------------
10186 c ----------------------------------------------------------------------
10190 do k=1,constr_homology
10192 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
10194 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
10196 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
10197 sum_sgdih=sum_sgdih+sgdih
10199 c grad_dih3=sum_sgdih/sum_gdih
10200 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
10202 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
10203 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
10204 ccc & gloc(nphi+i-3,icg)
10205 gloc(i,icg)=gloc(i,icg)+grad_dih3
10206 c if (i.eq.25) then
10207 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
10209 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
10210 ccc & gloc(nphi+i-3,icg)
10212 enddo ! i-loop for dih
10214 write(iout,*) "------- dih restrs end -------"
10217 c Pseudo-energy and gradient for theta angle restraints from
10218 c homology templates
10219 c FP 01/15 - inserted from econstr_local_test.F, loop structure
10223 c For constr_homology reference structures (FP)
10225 c Uconst_back_tot=0.0d0
10228 c Econstr_back legacy
10231 c do i=ithet_start,ithet_end
10234 c do i=loc_start,loc_end
10236 duscdiff(j,i)=0.0d0
10237 duscdiffx(j,i)=0.0d0
10243 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
10244 c write (iout,*) "waga_theta",waga_theta
10245 if (waga_theta.gt.0.0d0) then
10247 write (iout,*) "usampl",usampl
10248 write(iout,*) "------- theta restrs start -------"
10249 c do i=ithet_start,ithet_end
10250 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
10253 c write (iout,*) "maxres",maxres,"nres",nres
10255 do i=ithet_start,ithet_end
10257 c do i=1,nfrag_back
10258 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10260 c Deviation of theta angles wrt constr_homology ref structures
10262 utheta_i=0.0d0 ! argument of Gaussian for single k
10263 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10264 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
10265 c over residues in a fragment
10266 c write (iout,*) "theta(",i,")=",theta(i)
10267 do k=1,constr_homology
10269 c dtheta_i=theta(j)-thetaref(j,iref)
10270 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
10271 theta_diff(k)=thetatpl(k,i)-theta(i)
10273 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
10274 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
10275 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
10276 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
10277 c Gradient for single Gaussian restraint in subr Econstr_back
10278 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10281 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
10282 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
10286 c Gradient for multiple Gaussian restraint
10287 sum_gtheta=gutheta_i
10289 do k=1,constr_homology
10290 c New generalized expr for multiple Gaussian from Econstr_back
10291 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
10293 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
10294 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
10297 c Final value of gradient using same var as in Econstr_back
10298 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
10299 & *waga_homology(iset)
10300 c dutheta(i)=sum_sgtheta/sum_gtheta
10302 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
10304 Eval=Eval-dLOG(gutheta_i/constr_homology)
10305 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
10306 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
10307 c Uconst_back=Uconst_back+utheta(i)
10308 enddo ! (i-loop for theta)
10310 write(iout,*) "------- theta restrs end -------"
10314 c Deviation of local SC geometry
10316 c Separation of two i-loops (instructed by AL - 11/3/2014)
10318 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
10319 c write (iout,*) "waga_d",waga_d
10322 write(iout,*) "------- SC restrs start -------"
10323 write (iout,*) "Initial duscdiff,duscdiffx"
10324 do i=loc_start,loc_end
10325 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
10326 & (duscdiffx(jik,i),jik=1,3)
10329 do i=loc_start,loc_end
10330 usc_diff_i=0.0d0 ! argument of Gaussian for single k
10331 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10332 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
10333 c write(iout,*) "xxtab, yytab, zztab"
10334 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
10335 do k=1,constr_homology
10337 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10338 c Original sign inverted for calc of gradients (s. Econstr_back)
10339 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10340 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10341 c write(iout,*) "dxx, dyy, dzz"
10342 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10344 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
10345 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
10346 c uscdiffk(k)=usc_diff(i)
10347 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
10348 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
10349 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10350 c & xxref(j),yyref(j),zzref(j)
10355 c Generalized expression for multiple Gaussian acc to that for a single
10356 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
10358 c Original implementation
10359 c sum_guscdiff=guscdiff(i)
10361 c sum_sguscdiff=0.0d0
10362 c do k=1,constr_homology
10363 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
10364 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
10365 c sum_sguscdiff=sum_sguscdiff+sguscdiff
10368 c Implementation of new expressions for gradient (Jan. 2015)
10370 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
10372 do k=1,constr_homology
10374 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
10375 c before. Now the drivatives should be correct
10377 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10378 c Original sign inverted for calc of gradients (s. Econstr_back)
10379 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10380 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10382 c New implementation
10384 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
10385 & sigma_d(k,i) ! for the grad wrt r'
10386 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
10389 c New implementation
10390 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
10392 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
10393 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
10394 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
10395 duscdiff(jik,i)=duscdiff(jik,i)+
10396 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
10397 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
10398 duscdiffx(jik,i)=duscdiffx(jik,i)+
10399 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
10400 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
10403 write(iout,*) "jik",jik,"i",i
10404 write(iout,*) "dxx, dyy, dzz"
10405 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10406 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
10407 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
10408 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
10409 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
10410 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
10411 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
10412 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
10413 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
10414 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
10415 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
10416 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
10417 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
10418 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
10419 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
10426 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
10427 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
10429 c write (iout,*) i," uscdiff",uscdiff(i)
10431 c Put together deviations from local geometry
10433 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
10434 c & wfrag_back(3,i,iset)*uscdiff(i)
10435 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
10436 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
10437 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
10438 c Uconst_back=Uconst_back+usc_diff(i)
10440 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
10442 c New implment: multiplied by sum_sguscdiff
10445 enddo ! (i-loop for dscdiff)
10450 write(iout,*) "------- SC restrs end -------"
10451 write (iout,*) "------ After SC loop in e_modeller ------"
10452 do i=loc_start,loc_end
10453 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
10454 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
10456 if (waga_theta.eq.1.0d0) then
10457 write (iout,*) "in e_modeller after SC restr end: dutheta"
10458 do i=ithet_start,ithet_end
10459 write (iout,*) i,dutheta(i)
10462 if (waga_d.eq.1.0d0) then
10463 write (iout,*) "e_modeller after SC loop: duscdiff/x"
10465 write (iout,*) i,(duscdiff(j,i),j=1,3)
10466 write (iout,*) i,(duscdiffx(j,i),j=1,3)
10471 c Total energy from homology restraints
10473 write (iout,*) "odleg",odleg," kat",kat
10474 write (iout,*) "odleg",odleg," kat",kat
10475 write (iout,*) "Eval",Eval," Erot",Erot
10476 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
10477 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
10478 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
10481 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
10483 c ehomology_constr=odleg+kat
10485 c For Lorentzian-type Urestr
10488 if (waga_dist.ge.0.0d0) then
10490 c For Gaussian-type Urestr
10492 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
10493 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10494 ehomology_constr=waga_dist*odleg+waga_angle*kat+
10495 & waga_theta*Eval+waga_d*Erot
10496 c write (iout,*) "ehomology_constr=",ehomology_constr
10499 c For Lorentzian-type Urestr
10501 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
10502 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10503 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
10504 & waga_theta*Eval+waga_d*Erot
10505 c write (iout,*) "ehomology_constr=",ehomology_constr
10508 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
10509 & "Eval",waga_theta,eval,
10510 & "Erot",waga_d,Erot
10511 write (iout,*) "ehomology_constr",ehomology_constr
10515 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
10516 747 format(a12,i4,i4,i4,f8.3,f8.3)
10517 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
10518 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
10519 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
10520 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)