1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
9 cMS$ATTRIBUTES C :: proc_proc
12 include 'COMMON.IOUNITS'
13 double precision energia(0:max_ene),energia1(0:max_ene+1)
14 include 'COMMON.FFIELD'
15 include 'COMMON.DERIV'
16 include 'COMMON.INTERACT'
17 include 'COMMON.SBRIDGE'
18 include 'COMMON.CHAIN'
19 include 'COMMON.SHIELD'
20 include 'COMMON.CONTROL'
21 include 'COMMON.TORCNSTR'
23 double precision fact(6)
24 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
26 cd print *,'nnt=',nnt,' nct=',nct
28 C Compute the side-chain and electrostatic interaction energy
30 goto (101,102,103,104,105) ipot
31 C Lennard-Jones potential.
32 101 call elj(evdw,evdw_t)
33 cd print '(a)','Exit ELJ'
35 C Lennard-Jones-Kihara potential (shifted).
36 102 call eljk(evdw,evdw_t)
38 C Berne-Pechukas potential (dilated LJ, angular dependence).
39 103 call ebp(evdw,evdw_t)
41 C Gay-Berne potential (shifted LJ, angular dependence).
42 104 call egb(evdw,evdw_t)
44 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
45 105 call egbv(evdw,evdw_t)
47 C Calculate electrostatic (H-bonding) energy of the main chain.
50 c write (iout,*) "Sidechain"
53 if (shield_mode.eq.1) then
55 else if (shield_mode.eq.2) then
58 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
59 c write(iout,*) 'po eelec'
62 C Calculate excluded-volume interaction energy between peptide groups
65 call escp(evdw2,evdw2_14)
67 c Calculate the bond-stretching energy
71 C write (iout,*) "estr",estr
73 C Calculate the disulfide-bridge and other energy and the contributions
74 C from other distance constraints.
75 cd print *,'Calling EHPB'
77 cd print *,'EHPB exitted succesfully.'
79 C Calculate the virtual-bond-angle energy.
81 C print *,'Bend energy finished.'
83 if (tor_mode.eq.0) then
86 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
94 if (with_theta_constr) call etheta_constr(ethetacnstr)
95 c call ebend(ebe,ethetacnstr)
96 cd print *,'Bend energy finished.'
98 C Calculate the SC local energy.
101 C print *,'SCLOC energy finished.'
103 C Calculate the virtual-bond torsional energy.
105 if (wtor.gt.0.0d0) then
106 if (tor_mode.eq.0) then
107 call etor(etors,fact(1))
109 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
111 call etor_kcc(etors,fact(1))
117 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
118 c print *,"Processor",myrank," computed Utor"
120 C 6/23/01 Calculate double-torsional energy
122 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
123 call etor_d(etors_d,fact(2))
127 c print *,"Processor",myrank," computed Utord"
129 if (wsccor.gt.0.0d0) then
130 call eback_sc_corr(esccor)
135 if (wliptran.gt.0) then
136 call Eliptransfer(eliptran)
142 C 12/1/95 Multi-body terms
146 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
147 & .or. wturn6.gt.0.0d0) then
148 c write(iout,*)"calling multibody_eello"
149 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
150 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
151 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
158 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
159 c write (iout,*) "Calling multibody_hbond"
160 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
163 c write (iout,*) "NSAXS",nsaxs
164 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
165 call e_saxs(Esaxs_constr)
166 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
167 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
168 call e_saxsC(Esaxs_constr)
169 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
173 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
174 if (constr_homology.ge.1) then
175 call e_modeller(ehomology_constr)
177 ehomology_constr=0.0d0
180 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
182 C BARTEK for dfa test!
184 if (wdfa_dist.gt.0) call edfad(edfadis)
185 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
187 if (wdfa_tor.gt.0) call edfat(edfator)
188 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
190 if (wdfa_nei.gt.0) call edfan(edfanei)
191 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
193 if (wdfa_beta.gt.0) call edfab(edfabet)
194 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
203 if (shield_mode.gt.0) then
204 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
206 & +fact(1)*wvdwpp*evdw1
207 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
209 & +wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
210 & +wcorr6*fact(5)*ecorr6
211 & +wturn4*fact(3)*eello_turn4
212 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
213 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
214 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
215 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
216 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
219 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
221 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
222 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
223 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
224 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
225 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
226 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
227 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
228 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
232 if (shield_mode.gt.0) then
233 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
234 & +welec*fact(1)*(ees+evdw1)
235 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
236 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
237 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
238 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
239 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
240 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
241 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
242 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
245 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
246 & +welec*fact(1)*(ees+evdw1)
247 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
248 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
249 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
250 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
251 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
252 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
253 & +wliptran*eliptran+wsaxs*esaxs_constr+ehomology_constr
254 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
261 energia(2)=evdw2-evdw2_14
278 energia(8)=eello_turn3
279 energia(9)=eello_turn4
288 energia(20)=edihcnstr
291 energia(24)=ethetacnstr
292 energia(26)=esaxs_constr
293 energia(27)=ehomology_constr
301 if (isnan(etot).ne.0) energia(0)=1.0d+99
303 if (isnan(etot)) energia(0)=1.0d+99
308 idumm=proc_proc(etot,i)
310 call proc_proc(etot,i)
312 if(i.eq.1)energia(0)=1.0d+99
318 call enerprint(energia,fact)
322 C Sum up the components of the Cartesian gradient.
327 if (shield_mode.eq.0) then
328 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
329 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
331 & wstrain*ghpbc(j,i)+
332 & wcorr*fact(3)*gradcorr(j,i)+
333 & wel_loc*fact(2)*gel_loc(j,i)+
334 & wturn3*fact(2)*gcorr3_turn(j,i)+
335 & wturn4*fact(3)*gcorr4_turn(j,i)+
336 & wcorr5*fact(4)*gradcorr5(j,i)+
337 & wcorr6*fact(5)*gradcorr6(j,i)+
338 & wturn6*fact(5)*gcorr6_turn(j,i)+
339 & wsccor*fact(2)*gsccorc(j,i)
340 & +wliptran*gliptranc(j,i)+
341 & wdfa_dist*gdfad(j,i)+
342 & wdfa_tor*gdfat(j,i)+
343 & wdfa_nei*gdfan(j,i)+
344 & wdfa_beta*gdfab(j,i)
345 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
347 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
348 & wsccor*fact(2)*gsccorx(j,i)
349 & +wliptran*gliptranx(j,i)
351 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
352 & +fact(1)*wscp*gvdwc_scp(j,i)+
353 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
355 & wstrain*ghpbc(j,i)+
356 & wcorr*fact(3)*gradcorr(j,i)+
357 & wel_loc*fact(2)*gel_loc(j,i)+
358 & wturn3*fact(2)*gcorr3_turn(j,i)+
359 & wturn4*fact(3)*gcorr4_turn(j,i)+
360 & wcorr5*fact(4)*gradcorr5(j,i)+
361 & wcorr6*fact(5)*gradcorr6(j,i)+
362 & wturn6*fact(5)*gcorr6_turn(j,i)+
363 & wsccor*fact(2)*gsccorc(j,i)
364 & +wliptran*gliptranc(j,i)
365 & +welec*gshieldc(j,i)
366 & +welec*gshieldc_loc(j,i)
367 & +wcorr*gshieldc_ec(j,i)
368 & +wcorr*gshieldc_loc_ec(j,i)
369 & +wturn3*gshieldc_t3(j,i)
370 & +wturn3*gshieldc_loc_t3(j,i)
371 & +wturn4*gshieldc_t4(j,i)
372 & +wturn4*gshieldc_loc_t4(j,i)
373 & +wel_loc*gshieldc_ll(j,i)
374 & +wel_loc*gshieldc_loc_ll(j,i)+
375 & wdfa_dist*gdfad(j,i)+
376 & wdfa_tor*gdfat(j,i)+
377 & wdfa_nei*gdfan(j,i)+
378 & wdfa_beta*gdfab(j,i)
379 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
380 & +fact(1)*wscp*gradx_scp(j,i)+
382 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
383 & wsccor*fact(2)*gsccorx(j,i)
384 & +wliptran*gliptranx(j,i)
385 & +welec*gshieldx(j,i)
386 & +wcorr*gshieldx_ec(j,i)
387 & +wturn3*gshieldx_t3(j,i)
388 & +wturn4*gshieldx_t4(j,i)
389 & +wel_loc*gshieldx_ll(j,i)
397 if (shield_mode.eq.0) then
398 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
399 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
401 & wcorr*fact(3)*gradcorr(j,i)+
402 & wel_loc*fact(2)*gel_loc(j,i)+
403 & wturn3*fact(2)*gcorr3_turn(j,i)+
404 & wturn4*fact(3)*gcorr4_turn(j,i)+
405 & wcorr5*fact(4)*gradcorr5(j,i)+
406 & wcorr6*fact(5)*gradcorr6(j,i)+
407 & wturn6*fact(5)*gcorr6_turn(j,i)+
408 & wsccor*fact(2)*gsccorc(j,i)
409 & +wliptran*gliptranc(j,i)+
410 & wdfa_dist*gdfad(j,i)+
411 & wdfa_tor*gdfat(j,i)+
412 & wdfa_nei*gdfan(j,i)+
413 & wdfa_beta*gdfab(j,i)
414 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
416 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
417 & wsccor*fact(1)*gsccorx(j,i)
418 & +wliptran*gliptranx(j,i)
420 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
421 & fact(1)*wscp*gvdwc_scp(j,i)+
422 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
424 & wcorr*fact(3)*gradcorr(j,i)+
425 & wel_loc*fact(2)*gel_loc(j,i)+
426 & wturn3*fact(2)*gcorr3_turn(j,i)+
427 & wturn4*fact(3)*gcorr4_turn(j,i)+
428 & wcorr5*fact(4)*gradcorr5(j,i)+
429 & wcorr6*fact(5)*gradcorr6(j,i)+
430 & wturn6*fact(5)*gcorr6_turn(j,i)+
431 & wsccor*fact(2)*gsccorc(j,i)
432 & +wliptran*gliptranc(j,i)
433 & +welec*gshieldc(j,i)
434 & +welec*gshieldc_loc(j,i)
435 & +wcorr*gshieldc_ec(j,i)
436 & +wcorr*gshieldc_loc_ec(j,i)
437 & +wturn3*gshieldc_t3(j,i)
438 & +wturn3*gshieldc_loc_t3(j,i)
439 & +wturn4*gshieldc_t4(j,i)
440 & +wturn4*gshieldc_loc_t4(j,i)
441 & +wel_loc*gshieldc_ll(j,i)
442 & +wel_loc*gshieldc_loc_ll(j,i)+
443 & wdfa_dist*gdfad(j,i)+
444 & wdfa_tor*gdfat(j,i)+
445 & wdfa_nei*gdfan(j,i)+
446 & wdfa_beta*gdfab(j,i)
447 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
448 & fact(1)*wscp*gradx_scp(j,i)+
450 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
451 & wsccor*fact(1)*gsccorx(j,i)
452 & +wliptran*gliptranx(j,i)
453 & +welec*gshieldx(j,i)
454 & +wcorr*gshieldx_ec(j,i)
455 & +wturn3*gshieldx_t3(j,i)
456 & +wturn4*gshieldx_t4(j,i)
457 & +wel_loc*gshieldx_ll(j,i)
465 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
466 & +wcorr5*fact(4)*g_corr5_loc(i)
467 & +wcorr6*fact(5)*g_corr6_loc(i)
468 & +wturn4*fact(3)*gel_loc_turn4(i)
469 & +wturn3*fact(2)*gel_loc_turn3(i)
470 & +wturn6*fact(5)*gel_loc_turn6(i)
471 & +wel_loc*fact(2)*gel_loc_loc(i)
472 c & +wsccor*fact(1)*gsccor_loc(i)
473 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
476 if (dyn_ss) call dyn_set_nss
479 C------------------------------------------------------------------------
480 subroutine enerprint(energia,fact)
481 implicit real*8 (a-h,o-z)
483 include 'COMMON.IOUNITS'
484 include 'COMMON.FFIELD'
485 include 'COMMON.SBRIDGE'
486 include 'COMMON.CONTROL'
487 double precision energia(0:max_ene),fact(6)
489 evdw=energia(1)+fact(6)*energia(21)
491 evdw2=energia(2)+energia(17)
503 eello_turn3=energia(8)
504 eello_turn4=energia(9)
505 eello_turn6=energia(10)
512 edihcnstr=energia(20)
514 ethetacnstr=energia(24)
517 ehomology_constr=energia(27)
519 edfadis = energia(28)
520 edfator = energia(29)
521 edfanei = energia(30)
522 edfabet = energia(31)
527 write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
528 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
529 & etors_d,wtor_d*fact(2),ehpb,wstrain,
531 & ecorr,wcorr*fact(3),
532 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
535 & wel_loc*fact(2),eello_turn3,wturn3*fact(2),
536 & eello_turn4,wturn4*fact(3),
538 & eello_turn6,wturn6*fact(5),
540 & esccor,wsccor*fact(1),edihcnstr,
541 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
542 & etube,wtube,esaxs,wsaxs,ehomology_constr,
543 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
546 10 format (/'Virtual-chain energies:'//
547 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
548 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
549 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
550 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
551 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
552 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
553 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
554 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
555 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
556 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
557 & ' (SS bridges & dist. cnstr.)'/
559 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
560 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
561 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
563 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
564 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
565 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
567 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
569 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
570 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
571 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
572 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
573 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
574 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
575 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
576 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
577 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
578 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
579 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
580 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
581 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
582 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
583 & 'ETOT= ',1pE16.6,' (total)')
586 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
587 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
588 & etors_d,wtor_d*fact(2),ehpb,
590 & wstrain,ecorr,wcorr*fact(3),
591 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
593 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
594 & eello_turn4,wturn4*fact(3),
596 & eello_turn6,wturn6*fact(5),
598 & esccor,wsccor*fact(1),edihcnstr,
599 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
600 & etube,wtube,esaxs,wsaxs,ehomology_constr,
601 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
604 10 format (/'Virtual-chain energies:'//
605 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
606 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
607 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
608 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
609 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
610 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
611 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
612 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
613 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
614 & ' (SS bridges & dist. restr.)'/
616 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
617 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
618 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
620 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
621 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
622 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
624 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
626 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
627 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
628 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
629 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
630 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
631 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
632 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
633 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
634 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
635 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
636 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
637 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
638 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
639 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
640 & 'ETOT= ',1pE16.6,' (total)')
644 C-----------------------------------------------------------------------
645 subroutine elj(evdw,evdw_t)
647 C This subroutine calculates the interaction energy of nonbonded side chains
648 C assuming the LJ potential of interaction.
650 implicit real*8 (a-h,o-z)
652 include "DIMENSIONS.COMPAR"
653 parameter (accur=1.0d-10)
656 include 'COMMON.LOCAL'
657 include 'COMMON.CHAIN'
658 include 'COMMON.DERIV'
659 include 'COMMON.INTERACT'
660 include 'COMMON.TORSION'
661 include 'COMMON.SBRIDGE'
662 include 'COMMON.NAMES'
663 include 'COMMON.IOUNITS'
665 include 'COMMON.CONTACTS'
666 include 'COMMON.CONTMAT'
671 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
675 c eneps_temp(j,i)=0.0d0
684 if (itypi.eq.ntyp1) cycle
685 itypi1=iabs(itype(i+1))
689 call to_box(xi,yi,zi)
693 C Calculate SC interaction energy.
696 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
697 cd & 'iend=',iend(i,iint)
698 do j=istart(i,iint),iend(i,iint)
700 if (itypj.eq.ntyp1) cycle
704 call to_box(xj,yj,zj)
705 xj=boxshift(xj-xi,boxxsize)
706 yj=boxshift(yj-yi,boxysize)
707 zj=boxshift(zj-zi,boxzsize)
708 C Change 12/1/95 to calculate four-body interactions
709 rij=xj*xj+yj*yj+zj*zj
713 if (sss1.eq.0.0d0) cycle
714 sssgrad1=sscagrad(sqrij)
715 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
716 eps0ij=eps(itypi,itypj)
721 ij=icant(itypi,itypj)
723 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
724 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
727 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
728 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
729 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
730 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
731 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
732 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
733 if (bb.gt.0.0d0) then
734 evdw=evdw+sss1*evdwij
736 evdw_t=evdw_t+sss1*evdwij
740 C Calculate the components of the gradient in DC and X
742 fac=-rrij*(e1+evdwij)*sss1
743 & +evdwij*sssgrad1/sqrij/expon
748 gvdwx(k,i)=gvdwx(k,i)-gg(k)
749 gvdwx(k,j)=gvdwx(k,j)+gg(k)
753 gvdwc(l,k)=gvdwc(l,k)+gg(l)
759 C 12/1/95, revised on 5/20/97
761 C Calculate the contact function. The ith column of the array JCONT will
762 C contain the numbers of atoms that make contacts with the atom I (of numbers
763 C greater than I). The arrays FACONT and GACONT will contain the values of
764 C the contact function and its derivative.
766 C Uncomment next line, if the correlation interactions include EVDW explicitly.
767 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
768 C Uncomment next line, if the correlation interactions are contact function only
769 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
771 sigij=sigma(itypi,itypj)
772 r0ij=rs0(itypi,itypj)
774 C Check whether the SC's are not too far to make a contact.
777 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
778 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
780 if (fcont.gt.0.0D0) then
781 C If the SC-SC distance if close to sigma, apply spline.
782 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
783 cAdam & fcont1,fprimcont1)
784 cAdam fcont1=1.0d0-fcont1
785 cAdam if (fcont1.gt.0.0d0) then
786 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
787 cAdam fcont=fcont*fcont1
789 C Uncomment following 4 lines to have the geometric average of the epsilon0's
790 cga eps0ij=1.0d0/dsqrt(eps0ij)
792 cga gg(k)=gg(k)*eps0ij
794 cga eps0ij=-evdwij*eps0ij
795 C Uncomment for AL's type of SC correlation interactions.
797 num_conti=num_conti+1
799 facont(num_conti,i)=fcont*eps0ij
800 fprimcont=eps0ij*fprimcont/rij
802 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
803 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
804 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
805 C Uncomment following 3 lines for Skolnick's type of SC correlation.
806 gacont(1,num_conti,i)=-fprimcont*xj
807 gacont(2,num_conti,i)=-fprimcont*yj
808 gacont(3,num_conti,i)=-fprimcont*zj
809 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
810 cd write (iout,'(2i3,3f10.5)')
811 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
819 num_cont(i)=num_conti
825 gvdwc(j,i)=expon*gvdwc(j,i)
826 gvdwx(j,i)=expon*gvdwx(j,i)
830 C******************************************************************************
834 C To save time, the factor of EXPON has been extracted from ALL components
835 C of GVDWC and GRADX. Remember to multiply them by this factor before further
838 C******************************************************************************
841 C-----------------------------------------------------------------------------
842 subroutine eljk(evdw,evdw_t)
844 C This subroutine calculates the interaction energy of nonbonded side chains
845 C assuming the LJK potential of interaction.
847 implicit real*8 (a-h,o-z)
849 include "DIMENSIONS.COMPAR"
852 include 'COMMON.LOCAL'
853 include 'COMMON.CHAIN'
854 include 'COMMON.DERIV'
855 include 'COMMON.INTERACT'
856 include 'COMMON.IOUNITS'
857 include 'COMMON.NAMES'
862 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
865 c eneps_temp(j,i)=0.0d0
872 if (itypi.eq.ntyp1) cycle
873 itypi1=iabs(itype(i+1))
877 call to_box(xi,yi,zi)
879 C Calculate SC interaction energy.
882 do j=istart(i,iint),iend(i,iint)
884 if (itypj.eq.ntyp1) cycle
888 call to_box(xj,yj,zj)
889 xj=boxshift(xj-xi,boxxsize)
890 yj=boxshift(yj-yi,boxysize)
891 zj=boxshift(zj-zi,boxzsize)
892 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
894 e_augm=augm(itypi,itypj)*fac_augm
898 if (sss1.eq.0.0d0) cycle
899 sssgrad1=sscagrad(rij)
900 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
901 fac=r_shift_inv**expon
905 ij=icant(itypi,itypj)
906 c eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
907 c & /dabs(eps(itypi,itypj))
908 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
909 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
910 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
911 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
912 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
913 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
914 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
915 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
916 if (bb.gt.0.0d0) then
917 evdw=evdw+evdwij*sss1
919 evdw_t=evdw_t+evdwij*sss1
923 C Calculate the components of the gradient in DC and X
925 fac=(-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2))*sss1
926 & +evdwij*sssgrad1*r_inv_ij/expon
931 gvdwx(k,i)=gvdwx(k,i)-gg(k)
932 gvdwx(k,j)=gvdwx(k,j)+gg(k)
936 gvdwc(l,k)=gvdwc(l,k)+gg(l)
946 gvdwc(j,i)=expon*gvdwc(j,i)
947 gvdwx(j,i)=expon*gvdwx(j,i)
953 C-----------------------------------------------------------------------------
954 subroutine ebp(evdw,evdw_t)
956 C This subroutine calculates the interaction energy of nonbonded side chains
957 C assuming the Berne-Pechukas potential of interaction.
959 implicit real*8 (a-h,o-z)
961 include "DIMENSIONS.COMPAR"
964 include 'COMMON.LOCAL'
965 include 'COMMON.CHAIN'
966 include 'COMMON.DERIV'
967 include 'COMMON.NAMES'
968 include 'COMMON.INTERACT'
969 include 'COMMON.IOUNITS'
970 include 'COMMON.CALC'
972 c double precision rrsave(maxdim)
978 c eneps_temp(j,i)=0.0d0
983 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
984 c if (icall.eq.0) then
992 if (itypi.eq.ntyp1) cycle
993 itypi1=iabs(itype(i+1))
997 call to_box(xi,yi,zi)
998 dxi=dc_norm(1,nres+i)
999 dyi=dc_norm(2,nres+i)
1000 dzi=dc_norm(3,nres+i)
1001 dsci_inv=vbld_inv(i+nres)
1003 C Calculate SC interaction energy.
1005 do iint=1,nint_gr(i)
1006 do j=istart(i,iint),iend(i,iint)
1008 itypj=iabs(itype(j))
1009 if (itypj.eq.ntyp1) cycle
1010 dscj_inv=vbld_inv(j+nres)
1011 chi1=chi(itypi,itypj)
1012 chi2=chi(itypj,itypi)
1019 alf12=0.5D0*(alf1+alf2)
1020 C For diagnostics only!!!
1033 call to_box(xj,yj,zj)
1034 xj=boxshift(xj-xi,boxxsize)
1035 yj=boxshift(yj-yi,boxysize)
1036 zj=boxshift(zj-zi,boxzsize)
1037 dxj=dc_norm(1,nres+j)
1038 dyj=dc_norm(2,nres+j)
1039 dzj=dc_norm(3,nres+j)
1040 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1041 cd if (icall.eq.0) then
1047 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1049 C Calculate whole angle-dependent part of epsilon and contributions
1050 C to its derivatives
1051 fac=(rrij*sigsq)**expon2
1054 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1055 eps2der=evdwij*eps3rt
1056 eps3der=evdwij*eps2rt
1057 evdwij=evdwij*eps2rt*eps3rt
1058 ij=icant(itypi,itypj)
1059 aux=eps1*eps2rt**2*eps3rt**2
1060 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
1061 c & /dabs(eps(itypi,itypj))
1062 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
1063 if (bb.gt.0.0d0) then
1066 evdw_t=evdw_t+evdwij
1070 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1072 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1073 & restyp(itypi),i,restyp(itypj),j,
1074 & epsi,sigm,chi1,chi2,chip1,chip2,
1075 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1076 & om1,om2,om12,1.0D0/dsqrt(rrij),
1079 C Calculate gradient components.
1080 e1=e1*eps1*eps2rt**2*eps3rt**2
1081 fac=-expon*(e1+evdwij)
1084 C Calculate radial part of the gradient
1088 C Calculate the angular part of the gradient and sum add the contributions
1089 C to the appropriate components of the Cartesian gradient.
1098 C-----------------------------------------------------------------------------
1099 subroutine egb(evdw,evdw_t)
1101 C This subroutine calculates the interaction energy of nonbonded side chains
1102 C assuming the Gay-Berne potential of interaction.
1104 implicit real*8 (a-h,o-z)
1105 include 'DIMENSIONS'
1106 include "DIMENSIONS.COMPAR"
1107 include 'COMMON.CONTROL'
1108 include 'COMMON.GEO'
1109 include 'COMMON.VAR'
1110 include 'COMMON.LOCAL'
1111 include 'COMMON.CHAIN'
1112 include 'COMMON.DERIV'
1113 include 'COMMON.NAMES'
1114 include 'COMMON.INTERACT'
1115 include 'COMMON.IOUNITS'
1116 include 'COMMON.CALC'
1117 include 'COMMON.SBRIDGE'
1120 integer icant,xshift,yshift,zshift
1124 c eneps_temp(j,i)=0.0d0
1127 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1131 c if (icall.gt.0) lprn=.true.
1133 do i=iatsc_s,iatsc_e
1134 itypi=iabs(itype(i))
1135 if (itypi.eq.ntyp1) cycle
1136 itypi1=iabs(itype(i+1))
1140 C returning the ith atom to box
1141 call to_box(xi,yi,zi)
1142 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1143 dxi=dc_norm(1,nres+i)
1144 dyi=dc_norm(2,nres+i)
1145 dzi=dc_norm(3,nres+i)
1146 dsci_inv=vbld_inv(i+nres)
1148 C Calculate SC interaction energy.
1150 do iint=1,nint_gr(i)
1151 do j=istart(i,iint),iend(i,iint)
1152 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1153 call dyn_ssbond_ene(i,j,evdwij)
1155 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1156 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1157 C triple bond artifac removal
1158 do k=j+1,iend(i,iint)
1159 C search over all next residues
1160 if (dyn_ss_mask(k)) then
1161 C check if they are cysteins
1162 C write(iout,*) 'k=',k
1163 call triple_ssbond_ene(i,j,k,evdwij)
1164 C call the energy function that removes the artifical triple disulfide
1165 C bond the soubroutine is located in ssMD.F
1167 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1168 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1169 endif!dyn_ss_mask(k)
1173 itypj=iabs(itype(j))
1174 if (itypj.eq.ntyp1) cycle
1175 dscj_inv=vbld_inv(j+nres)
1176 sig0ij=sigma(itypi,itypj)
1177 chi1=chi(itypi,itypj)
1178 chi2=chi(itypj,itypi)
1185 alf12=0.5D0*(alf1+alf2)
1186 C For diagnostics only!!!
1199 C returning jth atom to box
1200 call to_box(xj,yj,zj)
1201 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1202 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1203 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1204 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1205 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1206 xj=boxshift(xj-xi,boxxsize)
1207 yj=boxshift(yj-yi,boxysize)
1208 zj=boxshift(zj-zi,boxzsize)
1209 dxj=dc_norm(1,nres+j)
1210 dyj=dc_norm(2,nres+j)
1211 dzj=dc_norm(3,nres+j)
1212 c write (iout,*) i,j,xj,yj,zj
1213 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1215 sss=sscale(1.0d0/rij)
1216 sssgrad=sscagrad(1.0d0/rij)
1217 if (sss.le.0.0) cycle
1218 C Calculate angle-dependent terms of energy and contributions to their
1223 sig=sig0ij*dsqrt(sigsq)
1224 rij_shift=1.0D0/rij-sig+sig0ij
1225 C I hate to put IF's in the loops, but here don't have another choice!!!!
1226 if (rij_shift.le.0.0D0) then
1231 c---------------------------------------------------------------
1232 rij_shift=1.0D0/rij_shift
1233 fac=rij_shift**expon
1236 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1237 eps2der=evdwij*eps3rt
1238 eps3der=evdwij*eps2rt
1239 evdwij=evdwij*eps2rt*eps3rt
1241 evdw=evdw+evdwij*sss
1243 evdw_t=evdw_t+evdwij*sss
1245 ij=icant(itypi,itypj)
1246 aux=eps1*eps2rt**2*eps3rt**2
1247 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1248 c & /dabs(eps(itypi,itypj))
1249 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1250 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1251 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1252 c & aux*e2/eps(itypi,itypj)
1254 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1258 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1259 & restyp(itypi),i,restyp(itypj),j,
1260 & epsi,sigm,chi1,chi2,chip1,chip2,
1261 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1262 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1264 write (iout,*) "partial sum", evdw, evdw_t
1268 if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)')
1269 & 'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij
1271 C Calculate gradient components.
1272 e1=e1*eps1*eps2rt**2*eps3rt**2
1273 fac=-expon*(e1+evdwij)*rij_shift
1276 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1277 C Calculate the radial part of the gradient
1278 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1279 & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1280 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1281 & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1282 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1283 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1287 C Calculate angular part of the gradient.
1290 C write(iout,*) "partial sum", evdw, evdw_t
1297 C-----------------------------------------------------------------------------
1298 subroutine egbv(evdw,evdw_t)
1300 C This subroutine calculates the interaction energy of nonbonded side chains
1301 C assuming the Gay-Berne-Vorobjev potential of interaction.
1303 implicit real*8 (a-h,o-z)
1304 include 'DIMENSIONS'
1305 include "DIMENSIONS.COMPAR"
1306 include 'COMMON.GEO'
1307 include 'COMMON.VAR'
1308 include 'COMMON.LOCAL'
1309 include 'COMMON.CHAIN'
1310 include 'COMMON.DERIV'
1311 include 'COMMON.NAMES'
1312 include 'COMMON.INTERACT'
1313 include 'COMMON.IOUNITS'
1314 include 'COMMON.CALC'
1315 common /srutu/ icall
1321 c eneps_temp(j,i)=0.0d0
1326 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1329 c if (icall.gt.0) lprn=.true.
1331 do i=iatsc_s,iatsc_e
1332 itypi=iabs(itype(i))
1333 if (itypi.eq.ntyp1) cycle
1334 itypi1=iabs(itype(i+1))
1338 call to_box(xi,yi,zi)
1339 call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
1340 dxi=dc_norm(1,nres+i)
1341 dyi=dc_norm(2,nres+i)
1342 dzi=dc_norm(3,nres+i)
1343 dsci_inv=vbld_inv(i+nres)
1345 C Calculate SC interaction energy.
1347 do iint=1,nint_gr(i)
1348 do j=istart(i,iint),iend(i,iint)
1350 itypj=iabs(itype(j))
1351 if (itypj.eq.ntyp1) cycle
1352 dscj_inv=vbld_inv(j+nres)
1353 sig0ij=sigma(itypi,itypj)
1354 r0ij=r0(itypi,itypj)
1355 chi1=chi(itypi,itypj)
1356 chi2=chi(itypj,itypi)
1363 alf12=0.5D0*(alf1+alf2)
1364 C For diagnostics only!!!
1377 call to_box(xj,yj,zj)
1378 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
1379 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1380 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1381 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1382 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1383 dxj=dc_norm(1,nres+j)
1384 dyj=dc_norm(2,nres+j)
1385 dzj=dc_norm(3,nres+j)
1386 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1388 sss=sscale(1.0d0/rij)
1389 if (sss.eq.0.0d0) cycle
1390 sssgrad=sscagrad(1.0d0/rij)
1391 C Calculate angle-dependent terms of energy and contributions to their
1395 sig=sig0ij*dsqrt(sigsq)
1396 rij_shift=1.0D0/rij-sig+r0ij
1397 C I hate to put IF's in the loops, but here don't have another choice!!!!
1398 if (rij_shift.le.0.0D0) then
1403 c---------------------------------------------------------------
1404 rij_shift=1.0D0/rij_shift
1405 fac=rij_shift**expon
1408 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1409 eps2der=evdwij*eps3rt
1410 eps3der=evdwij*eps2rt
1411 fac_augm=rrij**expon
1412 e_augm=augm(itypi,itypj)*fac_augm
1413 evdwij=evdwij*eps2rt*eps3rt
1414 if (bb.gt.0.0d0) then
1415 evdw=evdw+(evdwij+e_augm)*sss
1417 evdw_t=evdw_t+(evdwij+e_augm)*sss
1419 ij=icant(itypi,itypj)
1420 aux=eps1*eps2rt**2*eps3rt**2
1421 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1422 c & /dabs(eps(itypi,itypj))
1423 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1424 c eneps_temp(ij)=eneps_temp(ij)
1425 c & +(evdwij+e_augm)/eps(itypi,itypj)
1427 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1428 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1429 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1430 c & restyp(itypi),i,restyp(itypj),j,
1431 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1432 c & chi1,chi2,chip1,chip2,
1433 c & eps1,eps2rt**2,eps3rt**2,
1434 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1438 C Calculate gradient components.
1439 e1=e1*eps1*eps2rt**2*eps3rt**2
1440 fac=-expon*(e1+evdwij)*rij_shift
1442 fac=rij*fac-2*expon*rrij*e_augm
1443 fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
1444 C Calculate the radial part of the gradient
1445 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1446 & *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1447 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1448 & +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1449 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1450 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1454 C Calculate angular part of the gradient.
1462 C-----------------------------------------------------------------------------
1463 subroutine sc_angular
1464 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1465 C om12. Called by ebp, egb, and egbv.
1467 include 'COMMON.CALC'
1471 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1472 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1473 om12=dxi*dxj+dyi*dyj+dzi*dzj
1475 C Calculate eps1(om12) and its derivative in om12
1476 faceps1=1.0D0-om12*chiom12
1477 faceps1_inv=1.0D0/faceps1
1478 eps1=dsqrt(faceps1_inv)
1479 C Following variable is eps1*deps1/dom12
1480 eps1_om12=faceps1_inv*chiom12
1481 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1486 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1487 sigsq=1.0D0-facsig*faceps1_inv
1488 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1489 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1490 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1491 C Calculate eps2 and its derivatives in om1, om2, and om12.
1494 chipom12=chip12*om12
1495 facp=1.0D0-om12*chipom12
1497 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1498 C Following variable is the square root of eps2
1499 eps2rt=1.0D0-facp1*facp_inv
1500 C Following three variables are the derivatives of the square root of eps
1501 C in om1, om2, and om12.
1502 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1503 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1504 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1505 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1506 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1507 C Calculate whole angle-dependent part of epsilon and contributions
1508 C to its derivatives
1511 C----------------------------------------------------------------------------
1513 implicit real*8 (a-h,o-z)
1514 include 'DIMENSIONS'
1515 include 'COMMON.CHAIN'
1516 include 'COMMON.DERIV'
1517 include 'COMMON.CALC'
1518 double precision dcosom1(3),dcosom2(3)
1519 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1520 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1521 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1522 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1524 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1525 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1528 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1531 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1532 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1533 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1534 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1535 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1536 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1539 C Calculate the components of the gradient in DC and X
1543 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1548 c------------------------------------------------------------------------------
1549 subroutine vec_and_deriv
1550 implicit real*8 (a-h,o-z)
1551 include 'DIMENSIONS'
1552 include 'COMMON.IOUNITS'
1553 include 'COMMON.GEO'
1554 include 'COMMON.VAR'
1555 include 'COMMON.LOCAL'
1556 include 'COMMON.CHAIN'
1557 include 'COMMON.VECTORS'
1558 include 'COMMON.DERIV'
1559 include 'COMMON.INTERACT'
1560 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1561 C Compute the local reference systems. For reference system (i), the
1562 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1563 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1565 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1566 if (i.eq.nres-1) then
1567 C Case of the last full residue
1568 C Compute the Z-axis
1569 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1570 costh=dcos(pi-theta(nres))
1571 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1572 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1578 C Compute the derivatives of uz
1580 uzder(2,1,1)=-dc_norm(3,i-1)
1581 uzder(3,1,1)= dc_norm(2,i-1)
1582 uzder(1,2,1)= dc_norm(3,i-1)
1584 uzder(3,2,1)=-dc_norm(1,i-1)
1585 uzder(1,3,1)=-dc_norm(2,i-1)
1586 uzder(2,3,1)= dc_norm(1,i-1)
1589 uzder(2,1,2)= dc_norm(3,i)
1590 uzder(3,1,2)=-dc_norm(2,i)
1591 uzder(1,2,2)=-dc_norm(3,i)
1593 uzder(3,2,2)= dc_norm(1,i)
1594 uzder(1,3,2)= dc_norm(2,i)
1595 uzder(2,3,2)=-dc_norm(1,i)
1598 C Compute the Y-axis
1601 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1604 C Compute the derivatives of uy
1607 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1608 & -dc_norm(k,i)*dc_norm(j,i-1)
1609 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1611 uyder(j,j,1)=uyder(j,j,1)-costh
1612 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1617 uygrad(l,k,j,i)=uyder(l,k,j)
1618 uzgrad(l,k,j,i)=uzder(l,k,j)
1622 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1623 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1624 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1625 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1629 C Compute the Z-axis
1630 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1631 costh=dcos(pi-theta(i+2))
1632 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1637 C Compute the derivatives of uz
1639 uzder(2,1,1)=-dc_norm(3,i+1)
1640 uzder(3,1,1)= dc_norm(2,i+1)
1641 uzder(1,2,1)= dc_norm(3,i+1)
1643 uzder(3,2,1)=-dc_norm(1,i+1)
1644 uzder(1,3,1)=-dc_norm(2,i+1)
1645 uzder(2,3,1)= dc_norm(1,i+1)
1648 uzder(2,1,2)= dc_norm(3,i)
1649 uzder(3,1,2)=-dc_norm(2,i)
1650 uzder(1,2,2)=-dc_norm(3,i)
1652 uzder(3,2,2)= dc_norm(1,i)
1653 uzder(1,3,2)= dc_norm(2,i)
1654 uzder(2,3,2)=-dc_norm(1,i)
1657 C Compute the Y-axis
1660 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1663 C Compute the derivatives of uy
1666 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1667 & -dc_norm(k,i)*dc_norm(j,i+1)
1668 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1670 uyder(j,j,1)=uyder(j,j,1)-costh
1671 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1676 uygrad(l,k,j,i)=uyder(l,k,j)
1677 uzgrad(l,k,j,i)=uzder(l,k,j)
1681 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1682 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1683 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1684 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1690 vbld_inv_temp(1)=vbld_inv(i+1)
1691 if (i.lt.nres-1) then
1692 vbld_inv_temp(2)=vbld_inv(i+2)
1694 vbld_inv_temp(2)=vbld_inv(i)
1699 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1700 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1708 C--------------------------------------------------------------------------
1709 subroutine set_matrices
1710 implicit real*8 (a-h,o-z)
1711 include 'DIMENSIONS'
1715 integer status(MPI_STATUS_SIZE)
1717 include 'COMMON.IOUNITS'
1718 include 'COMMON.GEO'
1719 include 'COMMON.VAR'
1720 include 'COMMON.LOCAL'
1721 include 'COMMON.CHAIN'
1722 include 'COMMON.DERIV'
1723 include 'COMMON.INTERACT'
1724 include 'COMMON.CONTACTS'
1725 include 'COMMON.TORSION'
1726 include 'COMMON.VECTORS'
1727 include 'COMMON.FFIELD'
1728 include 'COMMON.CORRMAT'
1729 double precision auxvec(2),auxmat(2,2)
1731 C Compute the virtual-bond-torsional-angle dependent quantities needed
1732 C to calculate the el-loc multibody terms of various order.
1734 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1738 innt=chain_border(1,ii)
1739 inct=chain_border(2,ii)
1740 if (i.gt. innt+2 .and. i.lt.inct+2) then
1741 iti = itype2loc(itype(i-2))
1745 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1746 if (i.gt. innt+1 .and. i.lt.inct+1) then
1747 iti1 = itype2loc(itype(i-1))
1752 cost1=dcos(theta(i-1))
1753 sint1=dsin(theta(i-1))
1755 sint1cub=sint1sq*sint1
1756 sint1cost1=2*sint1*cost1
1758 write (iout,*) "bnew1",i,iti
1759 write (iout,*) (bnew1(k,1,iti),k=1,3)
1760 write (iout,*) (bnew1(k,2,iti),k=1,3)
1761 write (iout,*) "bnew2",i,iti
1762 write (iout,*) (bnew2(k,1,iti),k=1,3)
1763 write (iout,*) (bnew2(k,2,iti),k=1,3)
1766 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1768 gtb1(k,i-2)=cost1*b1k-sint1sq*
1769 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1770 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1772 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1773 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1776 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1777 cc(1,k,i-2)=sint1sq*aux
1778 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1779 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1780 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1781 dd(1,k,i-2)=sint1sq*aux
1782 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1783 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1785 cc(2,1,i-2)=cc(1,2,i-2)
1786 cc(2,2,i-2)=-cc(1,1,i-2)
1787 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1788 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1789 dd(2,1,i-2)=dd(1,2,i-2)
1790 dd(2,2,i-2)=-dd(1,1,i-2)
1791 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1792 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1795 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1796 EE(l,k,i-2)=sint1sq*aux
1798 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1801 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1802 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1803 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1804 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1806 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1807 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1808 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1810 c b1tilde(1,i-2)=b1(1,i-2)
1811 c b1tilde(2,i-2)=-b1(2,i-2)
1812 c b2tilde(1,i-2)=b2(1,i-2)
1813 c b2tilde(2,i-2)=-b2(2,i-2)
1815 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1816 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1817 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1818 write (iout,*) 'theta=', theta(i-1)
1821 if (i.gt. innt+2 .and. i.lt.inct+2) then
1822 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1823 iti = itype2loc(itype(i-2))
1827 c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
1828 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1829 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1830 iti1 = itype2loc(itype(i-1))
1834 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1835 c iti = itype2loc(itype(i-2))
1839 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1840 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1841 c iti1 = itype2loc(itype(i-1))
1851 CC(k,l,i-2)=ccold(k,l,iti)
1852 DD(k,l,i-2)=ddold(k,l,iti)
1853 EE(k,l,i-2)=eeold(k,l,iti)
1857 b1tilde(1,i-2)= b1(1,i-2)
1858 b1tilde(2,i-2)=-b1(2,i-2)
1859 b2tilde(1,i-2)= b2(1,i-2)
1860 b2tilde(2,i-2)=-b2(2,i-2)
1862 Ctilde(1,1,i-2)= CC(1,1,i-2)
1863 Ctilde(1,2,i-2)= CC(1,2,i-2)
1864 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1865 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1867 Dtilde(1,1,i-2)= DD(1,1,i-2)
1868 Dtilde(1,2,i-2)= DD(1,2,i-2)
1869 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1870 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1871 c write(iout,*) "i",i," iti",iti
1872 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1873 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1876 if (i .lt. nres+1) then
1913 if (i .gt. 3 .and. i .lt. nres+1) then
1914 obrot_der(1,i-2)=-sin1
1915 obrot_der(2,i-2)= cos1
1916 Ugder(1,1,i-2)= sin1
1917 Ugder(1,2,i-2)=-cos1
1918 Ugder(2,1,i-2)=-cos1
1919 Ugder(2,2,i-2)=-sin1
1922 obrot2_der(1,i-2)=-dwasin2
1923 obrot2_der(2,i-2)= dwacos2
1924 Ug2der(1,1,i-2)= dwasin2
1925 Ug2der(1,2,i-2)=-dwacos2
1926 Ug2der(2,1,i-2)=-dwacos2
1927 Ug2der(2,2,i-2)=-dwasin2
1929 obrot_der(1,i-2)=0.0d0
1930 obrot_der(2,i-2)=0.0d0
1931 Ugder(1,1,i-2)=0.0d0
1932 Ugder(1,2,i-2)=0.0d0
1933 Ugder(2,1,i-2)=0.0d0
1934 Ugder(2,2,i-2)=0.0d0
1935 obrot2_der(1,i-2)=0.0d0
1936 obrot2_der(2,i-2)=0.0d0
1937 Ug2der(1,1,i-2)=0.0d0
1938 Ug2der(1,2,i-2)=0.0d0
1939 Ug2der(2,1,i-2)=0.0d0
1940 Ug2der(2,2,i-2)=0.0d0
1942 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1943 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1944 iti = itype2loc(itype(i-2))
1948 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1949 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1950 iti1 = itype2loc(itype(i-1))
1954 cd write (iout,*) '*******i',i,' iti1',iti
1955 cd write (iout,*) 'b1',b1(:,iti)
1956 cd write (iout,*) 'b2',b2(:,iti)
1957 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1958 c if (i .gt. iatel_s+2) then
1959 if (i .gt. nnt+2) then
1960 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1962 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1963 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1965 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1966 c & EE(1,2,iti),EE(2,2,i)
1967 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1968 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1969 c write(iout,*) "Macierz EUG",
1970 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
1973 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
1975 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
1976 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
1977 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1978 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
1979 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
1991 DtUg2(l,k,i-2)=0.0d0
1995 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
1996 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
1998 muder(k,i-2)=Ub2der(k,i-2)
2000 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2001 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2002 if (itype(i-1).le.ntyp) then
2003 iti1 = itype2loc(itype(i-1))
2011 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2014 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2015 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2016 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2017 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2018 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2019 & ((ee(l,k,i-2),l=1,2),k=1,2)
2021 cd write (iout,*) 'mu1',mu1(:,i-2)
2022 cd write (iout,*) 'mu2',mu2(:,i-2)
2024 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2027 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2028 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2029 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2030 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2031 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2033 C Vectors and matrices dependent on a single virtual-bond dihedral.
2034 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2035 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2036 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2037 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2038 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2040 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2041 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2042 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2043 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2049 C Matrices dependent on two consecutive virtual-bond dihedrals.
2050 C The order of matrices is from left to right.
2051 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2054 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2056 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2057 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2059 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2060 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2062 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2063 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2064 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2071 C--------------------------------------------------------------------------
2072 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2074 C This subroutine calculates the average interaction energy and its gradient
2075 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2076 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2077 C The potential depends both on the distance of peptide-group centers and on
2078 C the orientation of the CA-CA virtual bonds.
2080 implicit real*8 (a-h,o-z)
2084 include 'DIMENSIONS'
2085 include 'COMMON.CONTROL'
2086 include 'COMMON.IOUNITS'
2087 include 'COMMON.GEO'
2088 include 'COMMON.VAR'
2089 include 'COMMON.LOCAL'
2090 include 'COMMON.CHAIN'
2091 include 'COMMON.DERIV'
2092 include 'COMMON.INTERACT'
2094 include 'COMMON.CONTACTS'
2095 include 'COMMON.CONTMAT'
2097 include 'COMMON.CORRMAT'
2098 include 'COMMON.TORSION'
2099 include 'COMMON.VECTORS'
2100 include 'COMMON.FFIELD'
2101 include 'COMMON.TIME1'
2102 include 'COMMON.SPLITELE'
2103 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2104 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2105 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2106 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2107 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2108 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2110 double precision sslipi,sslipj,ssgradlipi,ssgradlipj
2111 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj
2112 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2114 double precision scal_el /1.0d0/
2116 double precision scal_el /0.5d0/
2119 C 13-go grudnia roku pamietnego...
2120 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2121 & 0.0d0,1.0d0,0.0d0,
2122 & 0.0d0,0.0d0,1.0d0/
2123 cd write(iout,*) 'In EELEC'
2125 cd write(iout,*) 'Type',i
2126 cd write(iout,*) 'B1',B1(:,i)
2127 cd write(iout,*) 'B2',B2(:,i)
2128 cd write(iout,*) 'CC',CC(:,:,i)
2129 cd write(iout,*) 'DD',DD(:,:,i)
2130 cd write(iout,*) 'EE',EE(:,:,i)
2132 cd call check_vecgrad
2134 if (icheckgrad.eq.1) then
2136 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2138 dc_norm(k,i)=dc(k,i)*fac
2140 c write (iout,*) 'i',i,' fac',fac
2143 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2144 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2145 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2146 c call vec_and_deriv
2152 time_mat=time_mat+MPI_Wtime()-time01
2156 cd write (iout,*) 'i=',i
2158 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2161 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2162 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2177 cd print '(a)','Enter EELEC'
2178 c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2181 gel_loc_loc(i)=0.0d0
2186 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2188 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2190 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2191 do i=iturn3_start,iturn3_end
2193 C write(iout,*) "tu jest i",i
2194 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2195 C changes suggested by Ana to avoid out of bounds
2196 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2197 c & .or.((i+4).gt.nres)
2198 c & .or.((i-1).le.0)
2199 C end of changes by Ana
2200 C dobra zmiana wycofana
2201 & .or. itype(i+2).eq.ntyp1
2202 & .or. itype(i+3).eq.ntyp1) cycle
2203 C Adam: Instructions below will switch off existing interactions
2205 c if(itype(i-1).eq.ntyp1)cycle
2207 c if(i.LT.nres-3)then
2208 c if (itype(i+4).eq.ntyp1) cycle
2213 dx_normi=dc_norm(1,i)
2214 dy_normi=dc_norm(2,i)
2215 dz_normi=dc_norm(3,i)
2216 xmedi=c(1,i)+0.5d0*dxi
2217 ymedi=c(2,i)+0.5d0*dyi
2218 zmedi=c(3,i)+0.5d0*dzi
2219 call to_box(xmedi,ymedi,zmedi)
2220 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2222 call eelecij(i,i+2,ees,evdw1,eel_loc)
2223 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2225 num_cont_hb(i)=num_conti
2228 do i=iturn4_start,iturn4_end
2230 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2231 C changes suggested by Ana to avoid out of bounds
2232 c & .or.((i+5).gt.nres)
2233 c & .or.((i-1).le.0)
2234 C end of changes suggested by Ana
2235 & .or. itype(i+3).eq.ntyp1
2236 & .or. itype(i+4).eq.ntyp1
2237 c & .or. itype(i+5).eq.ntyp1
2238 c & .or. itype(i).eq.ntyp1
2239 c & .or. itype(i-1).eq.ntyp1
2244 dx_normi=dc_norm(1,i)
2245 dy_normi=dc_norm(2,i)
2246 dz_normi=dc_norm(3,i)
2247 xmedi=c(1,i)+0.5d0*dxi
2248 ymedi=c(2,i)+0.5d0*dyi
2249 zmedi=c(3,i)+0.5d0*dzi
2250 call to_box(xmedi,ymedi,zmedi)
2251 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2253 num_conti=num_cont_hb(i)
2255 c write(iout,*) "JESTEM W PETLI"
2256 call eelecij(i,i+3,ees,evdw1,eel_loc)
2257 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2258 & call eturn4(i,eello_turn4)
2260 num_cont_hb(i)=num_conti
2263 C Loop over all neighbouring boxes
2268 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2271 do i=iatel_s,iatel_e
2274 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2275 C changes suggested by Ana to avoid out of bounds
2276 c & .or.((i+2).gt.nres)
2277 c & .or.((i-1).le.0)
2278 C end of changes by Ana
2279 c & .or. itype(i+2).eq.ntyp1
2280 c & .or. itype(i-1).eq.ntyp1
2285 dx_normi=dc_norm(1,i)
2286 dy_normi=dc_norm(2,i)
2287 dz_normi=dc_norm(3,i)
2288 xmedi=c(1,i)+0.5d0*dxi
2289 ymedi=c(2,i)+0.5d0*dyi
2290 zmedi=c(3,i)+0.5d0*dzi
2291 call to_box(xmedi,ymedi,zmedi)
2292 call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
2294 num_conti=num_cont_hb(i)
2297 do j=ielstart(i),ielend(i)
2299 C write (iout,*) i,j
2301 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2302 C changes suggested by Ana to avoid out of bounds
2303 c & .or.((j+2).gt.nres)
2304 c & .or.((j-1).le.0)
2305 C end of changes by Ana
2306 c & .or.itype(j+2).eq.ntyp1
2307 c & .or.itype(j-1).eq.ntyp1
2309 call eelecij(i,j,ees,evdw1,eel_loc)
2312 num_cont_hb(i)=num_conti
2319 c write (iout,*) "Number of loop steps in EELEC:",ind
2321 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2322 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2324 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2325 ccc eel_loc=eel_loc+eello_turn3
2326 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2329 C-------------------------------------------------------------------------------
2330 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2331 implicit real*8 (a-h,o-z)
2332 include 'DIMENSIONS'
2336 include 'COMMON.CONTROL'
2337 include 'COMMON.IOUNITS'
2338 include 'COMMON.GEO'
2339 include 'COMMON.VAR'
2340 include 'COMMON.LOCAL'
2341 include 'COMMON.CHAIN'
2342 include 'COMMON.DERIV'
2343 include 'COMMON.INTERACT'
2345 include 'COMMON.CONTACTS'
2346 include 'COMMON.CONTMAT'
2348 include 'COMMON.CORRMAT'
2349 include 'COMMON.TORSION'
2350 include 'COMMON.VECTORS'
2351 include 'COMMON.FFIELD'
2352 include 'COMMON.TIME1'
2353 include 'COMMON.SPLITELE'
2354 include 'COMMON.SHIELD'
2355 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2356 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2357 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2358 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2359 & gmuij2(4),gmuji2(4)
2360 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2361 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2363 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij,
2365 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
2366 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2368 double precision scal_el /1.0d0/
2370 double precision scal_el /0.5d0/
2373 C 13-go grudnia roku pamietnego...
2374 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2375 & 0.0d0,1.0d0,0.0d0,
2376 & 0.0d0,0.0d0,1.0d0/
2377 integer xshift,yshift,zshift
2378 c time00=MPI_Wtime()
2379 cd write (iout,*) "eelecij",i,j
2383 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2384 aaa=app(iteli,itelj)
2385 bbb=bpp(iteli,itelj)
2386 ael6i=ael6(iteli,itelj)
2387 ael3i=ael3(iteli,itelj)
2391 dx_normj=dc_norm(1,j)
2392 dy_normj=dc_norm(2,j)
2393 dz_normj=dc_norm(3,j)
2394 C xj=c(1,j)+0.5D0*dxj-xmedi
2395 C yj=c(2,j)+0.5D0*dyj-ymedi
2396 C zj=c(3,j)+0.5D0*dzj-zmedi
2400 call to_box(xj,yj,zj)
2401 call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
2402 faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
2403 faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
2404 xj=boxshift(xj-xmedi,boxxsize)
2405 yj=boxshift(yj-ymedi,boxysize)
2406 zj=boxshift(zj-zmedi,boxzsize)
2407 rij=xj*xj+yj*yj+zj*zj
2408 sss=sscale(sqrt(rij))
2409 if (sss.eq.0.0d0) return
2410 sssgrad=sscagrad(sqrt(rij))
2411 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2412 c & " rlamb",rlamb," sss",sss
2413 c if (sss.gt.0.0d0) then
2419 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2420 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2421 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2422 fac=cosa-3.0D0*cosb*cosg
2424 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2425 if (j.eq.i+2) ev1=scal_el*ev1
2430 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2434 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2435 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2436 if (shield_mode.gt.0) then
2439 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2440 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2442 ees=ees+eesij*sss*faclipij2
2447 ees=ees+eesij*sss*faclipij2
2449 evdw1=evdw1+evdwij*sss*faclipij2
2450 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2451 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2452 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2453 cd & xmedi,ymedi,zmedi,xj,yj,zj
2455 if (energy_dec) then
2456 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2457 & 'evdw1',i,j,evdwij,iteli,itelj,aaa,evdw1,sss
2458 write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij,
2459 & fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij,
2464 C Calculate contributions to the Cartesian gradient.
2467 facvdw=-6*rrmij*(ev1+evdwij)*sss
2468 facel=-3*rrmij*(el1+eesij)
2475 * Radial derivatives. First process both termini of the fragment (i,j)
2478 aux=(facel*sss+rmij*sssgrad*eesij)*faclipij2
2482 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2483 & (shield_mode.gt.0)) then
2485 do ilist=1,ishield_list(i)
2486 iresshield=shield_list(ilist,i)
2488 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2490 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2492 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2493 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2494 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2495 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2496 C if (iresshield.gt.i) then
2497 C do ishi=i+1,iresshield-1
2498 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2499 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2503 C do ishi=iresshield,i
2504 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2505 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2511 do ilist=1,ishield_list(j)
2512 iresshield=shield_list(ilist,j)
2514 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2516 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2518 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2519 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2521 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2522 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2523 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2524 C if (iresshield.gt.j) then
2525 C do ishi=j+1,iresshield-1
2526 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2527 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2531 C do ishi=iresshield,j
2532 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2533 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2540 gshieldc(k,i)=gshieldc(k,i)+
2541 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2542 gshieldc(k,j)=gshieldc(k,j)+
2543 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2544 gshieldc(k,i-1)=gshieldc(k,i-1)+
2545 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2546 gshieldc(k,j-1)=gshieldc(k,j-1)+
2547 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2552 c ghalf=0.5D0*ggg(k)
2553 c gelc(k,i)=gelc(k,i)+ghalf
2554 c gelc(k,j)=gelc(k,j)+ghalf
2556 c 9/28/08 AL Gradient compotents will be summed only at the end
2557 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2559 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2560 C & +grad_shield(k,j)*eesij/fac_shield(j)
2561 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2562 C & +grad_shield(k,i)*eesij/fac_shield(i)
2563 C gelc_long(k,i-1)=gelc_long(k,i-1)
2564 C & +grad_shield(k,i)*eesij/fac_shield(i)
2565 C gelc_long(k,j-1)=gelc_long(k,j-1)
2566 C & +grad_shield(k,j)*eesij/fac_shield(j)
2568 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2571 * Loop over residues i+1 thru j-1.
2575 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2578 if (sss.gt.0.0) then
2579 facvdw=facvdw+sssgrad*rmij*evdwij*faclipij2
2589 c ghalf=0.5D0*ggg(k)
2590 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2591 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2593 c 9/28/08 AL Gradient compotents will be summed only at the end
2595 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2596 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2599 * Loop over residues i+1 thru j-1.
2603 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2609 facvdw=(ev1+evdwij)*faclipij2
2612 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2613 & +(evdwij+eesij)*sssgrad*rrmij
2618 * Radial derivatives. First process both termini of the fragment (i,j)
2622 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2624 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2626 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2628 c ghalf=0.5D0*ggg(k)
2629 c gelc(k,i)=gelc(k,i)+ghalf
2630 c gelc(k,j)=gelc(k,j)+ghalf
2632 c 9/28/08 AL Gradient compotents will be summed only at the end
2634 gelc_long(k,j)=gelc(k,j)+ggg(k)
2635 gelc_long(k,i)=gelc(k,i)-ggg(k)
2638 * Loop over residues i+1 thru j-1.
2642 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2645 c 9/28/08 AL Gradient compotents will be summed only at the end
2646 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2647 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2648 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2650 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2651 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2659 ecosa=2.0D0*fac3*fac1+fac4
2662 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2663 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2665 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2666 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2668 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2669 cd & (dcosg(k),k=1,3)
2671 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2672 & fac_shield(i)**2*fac_shield(j)**2*sss*faclipij2
2675 c ghalf=0.5D0*ggg(k)
2676 c gelc(k,i)=gelc(k,i)+ghalf
2677 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2678 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2679 c gelc(k,j)=gelc(k,j)+ghalf
2680 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2681 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2685 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2688 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2691 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2692 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2693 & *fac_shield(i)**2*fac_shield(j)**2*faclipij2
2695 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2696 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2697 & *fac_shield(i)**2*fac_shield(j)**2*faclipij2
2698 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2699 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2701 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2706 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2707 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2708 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2710 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2711 C energy of a peptide unit is assumed in the form of a second-order
2712 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2713 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2714 C are computed for EVERY pair of non-contiguous peptide groups.
2717 if (j.lt.nres-1) then
2729 muij(kkk)=mu(k,i)*mu(l,j)
2730 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2733 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2734 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2735 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2736 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2737 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2738 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2744 write (iout,*) 'EELEC: i',i,' j',j
2745 write (iout,*) 'j',j,' j1',j1,' j2',j2
2746 write(iout,*) 'muij',muij
2747 write (iout,*) "uy",uy(:,i)
2748 write (iout,*) "uz",uz(:,j)
2749 write (iout,*) "erij",erij
2751 ury=scalar(uy(1,i),erij)
2752 urz=scalar(uz(1,i),erij)
2753 vry=scalar(uy(1,j),erij)
2754 vrz=scalar(uz(1,j),erij)
2755 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2756 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2757 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2758 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2759 fac=dsqrt(-ael6i)*r3ij
2764 cd write (iout,'(4i5,4f10.5)')
2765 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2766 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2767 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2768 cd & uy(:,j),uz(:,j)
2769 cd write (iout,'(4f10.5)')
2770 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2771 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2772 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2773 cd write (iout,'(9f10.5/)')
2774 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2775 C Derivatives of the elements of A in virtual-bond vectors
2777 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2779 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2780 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2781 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2782 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2783 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2784 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2785 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2786 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2787 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2788 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2789 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2790 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2792 C Compute radial contributions to the gradient
2810 C Add the contributions coming from er
2813 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2814 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2815 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2816 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2819 C Derivatives in DC(i)
2820 cgrad ghalf1=0.5d0*agg(k,1)
2821 cgrad ghalf2=0.5d0*agg(k,2)
2822 cgrad ghalf3=0.5d0*agg(k,3)
2823 cgrad ghalf4=0.5d0*agg(k,4)
2824 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2825 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2826 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2827 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2828 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2829 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2830 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2831 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2832 C Derivatives in DC(i+1)
2833 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2834 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2835 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2836 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2837 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2838 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2839 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2840 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2841 C Derivatives in DC(j)
2842 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2843 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2844 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2845 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2846 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2847 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2848 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2849 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2850 C Derivatives in DC(j+1) or DC(nres-1)
2851 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2852 & -3.0d0*vryg(k,3)*ury)
2853 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2854 & -3.0d0*vrzg(k,3)*ury)
2855 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2856 & -3.0d0*vryg(k,3)*urz)
2857 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2858 & -3.0d0*vrzg(k,3)*urz)
2859 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2861 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2876 aggi(k,l)=-aggi(k,l)
2877 aggi1(k,l)=-aggi1(k,l)
2878 aggj(k,l)=-aggj(k,l)
2879 aggj1(k,l)=-aggj1(k,l)
2883 if (j.lt.nres-1) then
2889 aggi(k,l)=-aggi(k,l)
2890 aggi1(k,l)=-aggi1(k,l)
2891 aggj(k,l)=-aggj(k,l)
2892 aggj1(k,l)=-aggj1(k,l)
2903 aggi(k,l)=-aggi(k,l)
2904 aggi1(k,l)=-aggi1(k,l)
2905 aggj(k,l)=-aggj(k,l)
2906 aggj1(k,l)=-aggj1(k,l)
2911 IF (wel_loc.gt.0.0d0) THEN
2912 C Contribution to the local-electrostatic energy coming from the i-j pair
2913 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2916 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
2918 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
2919 & " wel_loc",wel_loc
2921 if (shield_mode.eq.0) then
2928 eel_loc_ij=eel_loc_ij
2929 & *fac_shield(i)*fac_shield(j)*sss*faclipij
2930 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2931 & 'eelloc',i,j,eel_loc_ij
2932 c if (eel_loc_ij.ne.0)
2933 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
2934 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
2936 eel_loc=eel_loc+eel_loc_ij
2937 C Now derivative over eel_loc
2939 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2940 & (shield_mode.gt.0)) then
2943 do ilist=1,ishield_list(i)
2944 iresshield=shield_list(ilist,i)
2946 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2949 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2951 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2952 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2956 do ilist=1,ishield_list(j)
2957 iresshield=shield_list(ilist,j)
2959 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2962 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2964 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2965 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2972 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2973 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2974 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2975 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2976 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2977 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2978 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2979 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2984 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
2985 c & ' eel_loc_ij',eel_loc_ij
2986 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2987 C Calculate patrial derivative for theta angle
2989 geel_loc_ij=(a22*gmuij1(1)
2993 & *fac_shield(i)*fac_shield(j)*sss*faclipij
2994 c write(iout,*) "derivative over thatai"
2995 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
2997 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
2998 & geel_loc_ij*wel_loc
2999 c write(iout,*) "derivative over thatai-1"
3000 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3007 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3008 & geel_loc_ij*wel_loc
3009 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3011 c Derivative over j residue
3012 geel_loc_ji=a22*gmuji1(1)
3016 c write(iout,*) "derivative over thataj"
3017 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3020 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3021 & geel_loc_ji*wel_loc
3022 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3029 c write(iout,*) "derivative over thataj-1"
3030 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3032 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3033 & geel_loc_ji*wel_loc
3034 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3036 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3038 C Partial derivatives in virtual-bond dihedral angles gamma
3040 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3041 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3042 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3043 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3045 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3046 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3047 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3048 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3049 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3050 aux=eel_loc_ij/sss*sssgrad*rmij
3055 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3056 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3057 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3058 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3059 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3060 cgrad ghalf=0.5d0*ggg(l)
3061 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3062 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3066 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3069 C Remaining derivatives of eello
3070 gel_loc_long(3,j)=gel_loc_long(3,j)+
3071 & ssgradlipj*eel_loc_ij/2.0d0*lipscale/faclipij
3073 gel_loc_long(3,i)=gel_loc_long(3,i)+
3074 & ssgradlipi*eel_loc_ij/2.0d0*lipscale/faclipij
3076 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3077 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3078 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3080 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3081 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3082 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3084 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3085 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3086 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3088 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3089 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3090 & *fac_shield(i)*fac_shield(j)*sss*faclipij
3097 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3098 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3100 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3101 & .and. num_conti.le.maxconts) then
3102 c write (iout,*) i,j," entered corr"
3104 C Calculate the contact function. The ith column of the array JCONT will
3105 C contain the numbers of atoms that make contacts with the atom I (of numbers
3106 C greater than I). The arrays FACONT and GACONT will contain the values of
3107 C the contact function and its derivative.
3108 c r0ij=1.02D0*rpp(iteli,itelj)
3109 c r0ij=1.11D0*rpp(iteli,itelj)
3110 r0ij=2.20D0*rpp(iteli,itelj)
3111 c r0ij=1.55D0*rpp(iteli,itelj)
3112 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3113 if (fcont.gt.0.0D0) then
3114 num_conti=num_conti+1
3115 if (num_conti.gt.maxconts) then
3116 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3117 & ' will skip next contacts for this conf.'
3119 jcont_hb(num_conti,i)=j
3120 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3121 cd & " jcont_hb",jcont_hb(num_conti,i)
3122 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3123 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3124 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3126 d_cont(num_conti,i)=rij
3127 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3128 C --- Electrostatic-interaction matrix ---
3129 a_chuj(1,1,num_conti,i)=a22
3130 a_chuj(1,2,num_conti,i)=a23
3131 a_chuj(2,1,num_conti,i)=a32
3132 a_chuj(2,2,num_conti,i)=a33
3133 C --- Gradient of rij
3136 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3143 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3144 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3145 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3146 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3147 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3153 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3154 C Calculate contact energies
3156 wij=cosa-3.0D0*cosb*cosg
3159 c fac3=dsqrt(-ael6i)/r0ij**3
3160 fac3=dsqrt(-ael6i)*r3ij
3161 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3162 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3163 if (ees0tmp.gt.0) then
3164 ees0pij=dsqrt(ees0tmp)
3168 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3169 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3170 if (ees0tmp.gt.0) then
3171 ees0mij=dsqrt(ees0tmp)
3176 if (shield_mode.eq.0) then
3180 ees0plist(num_conti,i)=j
3181 C fac_shield(i)=0.4d0
3182 C fac_shield(j)=0.6d0
3184 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3185 & *fac_shield(i)*fac_shield(j)
3186 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3187 & *fac_shield(i)*fac_shield(j)
3188 C Diagnostics. Comment out or remove after debugging!
3189 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3190 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3191 c ees0m(num_conti,i)=0.0D0
3193 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3194 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3195 C Angular derivatives of the contact function
3197 ees0pij1=fac3/ees0pij
3198 ees0mij1=fac3/ees0mij
3199 fac3p=-3.0D0*fac3*rrmij
3200 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3201 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3203 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3204 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3205 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3206 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3207 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3208 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3209 ecosap=ecosa1+ecosa2
3210 ecosbp=ecosb1+ecosb2
3211 ecosgp=ecosg1+ecosg2
3212 ecosam=ecosa1-ecosa2
3213 ecosbm=ecosb1-ecosb2
3214 ecosgm=ecosg1-ecosg2
3223 facont_hb(num_conti,i)=fcont
3226 fprimcont=fprimcont/rij
3227 cd facont_hb(num_conti,i)=1.0D0
3228 C Following line is for diagnostics.
3231 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3232 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3235 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3236 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3238 gggp(1)=gggp(1)+ees0pijp*xj
3239 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3240 gggp(2)=gggp(2)+ees0pijp*yj
3241 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3242 gggp(3)=gggp(3)+ees0pijp*zj
3243 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3244 gggm(1)=gggm(1)+ees0mijp*xj
3245 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3246 gggm(2)=gggm(2)+ees0mijp*yj
3247 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3248 gggm(3)=gggm(3)+ees0mijp*zj
3249 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3250 C Derivatives due to the contact function
3251 gacont_hbr(1,num_conti,i)=fprimcont*xj
3252 gacont_hbr(2,num_conti,i)=fprimcont*yj
3253 gacont_hbr(3,num_conti,i)=fprimcont*zj
3256 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3257 c following the change of gradient-summation algorithm.
3259 cgrad ghalfp=0.5D0*gggp(k)
3260 cgrad ghalfm=0.5D0*gggm(k)
3261 gacontp_hb1(k,num_conti,i)=!ghalfp
3262 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3263 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3264 & *fac_shield(i)*fac_shield(j)*sss
3266 gacontp_hb2(k,num_conti,i)=!ghalfp
3267 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3268 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3269 & *fac_shield(i)*fac_shield(j)*sss
3271 gacontp_hb3(k,num_conti,i)=gggp(k)
3272 & *fac_shield(i)*fac_shield(j)*sss
3274 gacontm_hb1(k,num_conti,i)=!ghalfm
3275 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3276 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3277 & *fac_shield(i)*fac_shield(j)*sss
3279 gacontm_hb2(k,num_conti,i)=!ghalfm
3280 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3281 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3282 & *fac_shield(i)*fac_shield(j)*sss
3284 gacontm_hb3(k,num_conti,i)=gggm(k)
3285 & *fac_shield(i)*fac_shield(j)
3288 C Diagnostics. Comment out or remove after debugging!
3290 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3291 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3292 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3293 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3294 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3295 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3301 endif ! num_conti.le.maxconts
3306 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3309 ghalf=0.5d0*agg(l,k)
3310 aggi(l,k)=aggi(l,k)+ghalf
3311 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3312 aggj(l,k)=aggj(l,k)+ghalf
3315 if (j.eq.nres-1 .and. i.lt.j-2) then
3318 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3324 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3327 C-----------------------------------------------------------------------------
3328 subroutine eturn3(i,eello_turn3)
3329 C Third- and fourth-order contributions from turns
3330 implicit real*8 (a-h,o-z)
3331 include 'DIMENSIONS'
3332 include 'COMMON.IOUNITS'
3333 include 'COMMON.GEO'
3334 include 'COMMON.VAR'
3335 include 'COMMON.LOCAL'
3336 include 'COMMON.CHAIN'
3337 include 'COMMON.DERIV'
3338 include 'COMMON.INTERACT'
3339 include 'COMMON.CORRMAT'
3340 include 'COMMON.TORSION'
3341 include 'COMMON.VECTORS'
3342 include 'COMMON.FFIELD'
3343 include 'COMMON.CONTROL'
3344 include 'COMMON.SHIELD'
3346 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3347 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3348 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3349 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3350 & auxgmat2(2,2),auxgmatt2(2,2)
3351 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3352 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3353 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3354 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3356 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3357 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3359 c write (iout,*) "eturn3",i,j,j1,j2
3364 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3366 C Third-order contributions
3373 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3374 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3375 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3376 c auxalary matices for theta gradient
3377 c auxalary matrix for i+1 and constant i+2
3378 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3379 c auxalary matrix for i+2 and constant i+1
3380 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3381 call transpose2(auxmat(1,1),auxmat1(1,1))
3382 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3383 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3384 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3385 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3386 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3387 if (shield_mode.eq.0) then
3394 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3395 & *fac_shield(i)*fac_shield(j)*faclipij
3396 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3397 & *fac_shield(i)*fac_shield(j)
3398 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3402 C Derivatives in theta
3403 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3404 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3405 & *fac_shield(i)*fac_shield(j)*faclipij
3406 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3407 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3408 & *fac_shield(i)*fac_shield(j)*faclipij
3411 C Derivatives in shield mode
3412 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3413 & (shield_mode.gt.0)) then
3416 do ilist=1,ishield_list(i)
3417 iresshield=shield_list(ilist,i)
3419 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3421 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3423 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3424 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3428 do ilist=1,ishield_list(j)
3429 iresshield=shield_list(ilist,j)
3431 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3433 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3435 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3436 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3443 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3444 & grad_shield(k,i)*eello_t3/fac_shield(i)
3445 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3446 & grad_shield(k,j)*eello_t3/fac_shield(j)
3447 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3448 & grad_shield(k,i)*eello_t3/fac_shield(i)
3449 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3450 & grad_shield(k,j)*eello_t3/fac_shield(j)
3454 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3455 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3456 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3457 cd & ' eello_turn3_num',4*eello_turn3_num
3458 C Derivatives in gamma(i)
3459 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3460 call transpose2(auxmat2(1,1),auxmat3(1,1))
3461 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3462 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3463 & *fac_shield(i)*fac_shield(j)*faclipij
3464 C Derivatives in gamma(i+1)
3465 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3466 call transpose2(auxmat2(1,1),auxmat3(1,1))
3467 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3468 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3469 & +0.5d0*(pizda(1,1)+pizda(2,2))
3470 & *fac_shield(i)*fac_shield(j)*faclipij
3471 C Cartesian derivatives
3473 c ghalf1=0.5d0*agg(l,1)
3474 c ghalf2=0.5d0*agg(l,2)
3475 c ghalf3=0.5d0*agg(l,3)
3476 c ghalf4=0.5d0*agg(l,4)
3477 a_temp(1,1)=aggi(l,1)!+ghalf1
3478 a_temp(1,2)=aggi(l,2)!+ghalf2
3479 a_temp(2,1)=aggi(l,3)!+ghalf3
3480 a_temp(2,2)=aggi(l,4)!+ghalf4
3481 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3482 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3483 & +0.5d0*(pizda(1,1)+pizda(2,2))
3484 & *fac_shield(i)*fac_shield(j)*faclipij
3486 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3487 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3488 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3489 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3490 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3491 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3492 & +0.5d0*(pizda(1,1)+pizda(2,2))
3493 & *fac_shield(i)*fac_shield(j)*faclipij
3494 a_temp(1,1)=aggj(l,1)!+ghalf1
3495 a_temp(1,2)=aggj(l,2)!+ghalf2
3496 a_temp(2,1)=aggj(l,3)!+ghalf3
3497 a_temp(2,2)=aggj(l,4)!+ghalf4
3498 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3499 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3500 & +0.5d0*(pizda(1,1)+pizda(2,2))
3501 & *fac_shield(i)*fac_shield(j)*faclipij
3502 a_temp(1,1)=aggj1(l,1)
3503 a_temp(1,2)=aggj1(l,2)
3504 a_temp(2,1)=aggj1(l,3)
3505 a_temp(2,2)=aggj1(l,4)
3506 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3507 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3508 & +0.5d0*(pizda(1,1)+pizda(2,2))
3509 & *fac_shield(i)*fac_shield(j)*faclipij
3516 C-------------------------------------------------------------------------------
3517 subroutine eturn4(i,eello_turn4)
3518 C Third- and fourth-order contributions from turns
3519 implicit real*8 (a-h,o-z)
3520 include 'DIMENSIONS'
3521 include 'COMMON.IOUNITS'
3522 include 'COMMON.GEO'
3523 include 'COMMON.VAR'
3524 include 'COMMON.LOCAL'
3525 include 'COMMON.CHAIN'
3526 include 'COMMON.DERIV'
3527 include 'COMMON.INTERACT'
3528 include 'COMMON.CORRMAT'
3529 include 'COMMON.TORSION'
3530 include 'COMMON.VECTORS'
3531 include 'COMMON.FFIELD'
3532 include 'COMMON.CONTROL'
3533 include 'COMMON.SHIELD'
3535 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3536 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3537 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3538 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3539 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3540 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3541 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3542 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3543 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3544 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3545 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3547 double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3548 common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
3550 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3552 C Fourth-order contributions
3560 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3561 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3562 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3563 c write(iout,*)"WCHODZE W PROGRAM"
3568 iti1=itype2loc(itype(i+1))
3569 iti2=itype2loc(itype(i+2))
3570 iti3=itype2loc(itype(i+3))
3571 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3572 call transpose2(EUg(1,1,i+1),e1t(1,1))
3573 call transpose2(Eug(1,1,i+2),e2t(1,1))
3574 call transpose2(Eug(1,1,i+3),e3t(1,1))
3575 C Ematrix derivative in theta
3576 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3577 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3578 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3579 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3580 c eta1 in derivative theta
3581 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3582 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3583 c auxgvec is derivative of Ub2 so i+3 theta
3584 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3585 c auxalary matrix of E i+1
3586 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3589 s1=scalar2(b1(1,i+2),auxvec(1))
3590 c derivative of theta i+2 with constant i+3
3591 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3592 c derivative of theta i+2 with constant i+2
3593 gs32=scalar2(b1(1,i+2),auxgvec(1))
3594 c derivative of E matix in theta of i+1
3595 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3597 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3598 c ea31 in derivative theta
3599 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3600 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3601 c auxilary matrix auxgvec of Ub2 with constant E matirx
3602 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3603 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3604 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3608 s2=scalar2(b1(1,i+1),auxvec(1))
3609 c derivative of theta i+1 with constant i+3
3610 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3611 c derivative of theta i+2 with constant i+1
3612 gs21=scalar2(b1(1,i+1),auxgvec(1))
3613 c derivative of theta i+3 with constant i+1
3614 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3615 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3617 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3618 c two derivatives over diffetent matrices
3619 c gtae3e2 is derivative over i+3
3620 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3621 c ae3gte2 is derivative over i+2
3622 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3623 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3624 c three possible derivative over theta E matices
3626 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3628 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3630 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3631 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3633 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3634 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3635 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3636 if (shield_mode.eq.0) then
3643 eello_turn4=eello_turn4-(s1+s2+s3)
3644 & *fac_shield(i)*fac_shield(j)*faclipij
3645 eello_t4=-(s1+s2+s3)
3646 & *fac_shield(i)*fac_shield(j)
3647 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3648 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3649 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3650 C Now derivative over shield:
3651 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3652 & (shield_mode.gt.0)) then
3655 do ilist=1,ishield_list(i)
3656 iresshield=shield_list(ilist,i)
3658 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3660 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3662 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3663 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3667 do ilist=1,ishield_list(j)
3668 iresshield=shield_list(ilist,j)
3670 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3672 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3674 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3675 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3682 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3683 & grad_shield(k,i)*eello_t4/fac_shield(i)
3684 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3685 & grad_shield(k,j)*eello_t4/fac_shield(j)
3686 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3687 & grad_shield(k,i)*eello_t4/fac_shield(i)
3688 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3689 & grad_shield(k,j)*eello_t4/fac_shield(j)
3692 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3693 cd & ' eello_turn4_num',8*eello_turn4_num
3695 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3696 & -(gs13+gsE13+gsEE1)*wturn4
3697 & *fac_shield(i)*fac_shield(j)
3698 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3699 & -(gs23+gs21+gsEE2)*wturn4
3700 & *fac_shield(i)*fac_shield(j)
3702 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3703 & -(gs32+gsE31+gsEE3)*wturn4
3704 & *fac_shield(i)*fac_shield(j)
3706 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3709 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3710 & 'eturn4',i,j,-(s1+s2+s3)
3711 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3712 c & ' eello_turn4_num',8*eello_turn4_num
3713 C Derivatives in gamma(i)
3714 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3715 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3716 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3717 s1=scalar2(b1(1,i+2),auxvec(1))
3718 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3719 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3720 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3721 & *fac_shield(i)*fac_shield(j)*faclipij
3722 C Derivatives in gamma(i+1)
3723 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3724 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3725 s2=scalar2(b1(1,i+1),auxvec(1))
3726 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3727 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3728 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3729 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3730 & *fac_shield(i)*fac_shield(j)*faclipij
3731 C Derivatives in gamma(i+2)
3732 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3733 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3734 s1=scalar2(b1(1,i+2),auxvec(1))
3735 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3736 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3737 s2=scalar2(b1(1,i+1),auxvec(1))
3738 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3739 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3740 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3741 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3742 & *fac_shield(i)*fac_shield(j)*faclipij
3744 C Cartesian derivatives
3745 C Derivatives of this turn contributions in DC(i+2)
3746 if (j.lt.nres-1) then
3748 a_temp(1,1)=agg(l,1)
3749 a_temp(1,2)=agg(l,2)
3750 a_temp(2,1)=agg(l,3)
3751 a_temp(2,2)=agg(l,4)
3752 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3753 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3754 s1=scalar2(b1(1,i+2),auxvec(1))
3755 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3756 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3757 s2=scalar2(b1(1,i+1),auxvec(1))
3758 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3759 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3760 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3762 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3763 & *fac_shield(i)*fac_shield(j)*faclipij
3766 C Remaining derivatives of this turn contribution
3768 a_temp(1,1)=aggi(l,1)
3769 a_temp(1,2)=aggi(l,2)
3770 a_temp(2,1)=aggi(l,3)
3771 a_temp(2,2)=aggi(l,4)
3772 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3773 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3774 s1=scalar2(b1(1,i+2),auxvec(1))
3775 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3776 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3777 s2=scalar2(b1(1,i+1),auxvec(1))
3778 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3779 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3780 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3781 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3782 & *fac_shield(i)*fac_shield(j)*faclipij
3783 a_temp(1,1)=aggi1(l,1)
3784 a_temp(1,2)=aggi1(l,2)
3785 a_temp(2,1)=aggi1(l,3)
3786 a_temp(2,2)=aggi1(l,4)
3787 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3788 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3789 s1=scalar2(b1(1,i+2),auxvec(1))
3790 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3791 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3792 s2=scalar2(b1(1,i+1),auxvec(1))
3793 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3794 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3795 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3796 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3797 & *fac_shield(i)*fac_shield(j)*faclipij
3798 a_temp(1,1)=aggj(l,1)
3799 a_temp(1,2)=aggj(l,2)
3800 a_temp(2,1)=aggj(l,3)
3801 a_temp(2,2)=aggj(l,4)
3802 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3803 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3804 s1=scalar2(b1(1,i+2),auxvec(1))
3805 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3806 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3807 s2=scalar2(b1(1,i+1),auxvec(1))
3808 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3809 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3810 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3811 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3812 & *fac_shield(i)*fac_shield(j)*faclipij
3813 a_temp(1,1)=aggj1(l,1)
3814 a_temp(1,2)=aggj1(l,2)
3815 a_temp(2,1)=aggj1(l,3)
3816 a_temp(2,2)=aggj1(l,4)
3817 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3818 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3819 s1=scalar2(b1(1,i+2),auxvec(1))
3820 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3821 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3822 s2=scalar2(b1(1,i+1),auxvec(1))
3823 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3824 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3825 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3826 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3827 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3828 & *fac_shield(i)*fac_shield(j)*faclipij
3835 C-----------------------------------------------------------------------------
3836 subroutine vecpr(u,v,w)
3837 implicit real*8(a-h,o-z)
3838 dimension u(3),v(3),w(3)
3839 w(1)=u(2)*v(3)-u(3)*v(2)
3840 w(2)=-u(1)*v(3)+u(3)*v(1)
3841 w(3)=u(1)*v(2)-u(2)*v(1)
3844 C-----------------------------------------------------------------------------
3845 subroutine unormderiv(u,ugrad,unorm,ungrad)
3846 C This subroutine computes the derivatives of a normalized vector u, given
3847 C the derivatives computed without normalization conditions, ugrad. Returns
3850 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3851 double precision vec(3)
3852 double precision scalar
3854 c write (2,*) 'ugrad',ugrad
3857 vec(i)=scalar(ugrad(1,i),u(1))
3859 c write (2,*) 'vec',vec
3862 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3865 c write (2,*) 'ungrad',ungrad
3868 C-----------------------------------------------------------------------------
3869 subroutine escp(evdw2,evdw2_14)
3871 C This subroutine calculates the excluded-volume interaction energy between
3872 C peptide-group centers and side chains and its gradient in virtual-bond and
3873 C side-chain vectors.
3875 implicit real*8 (a-h,o-z)
3876 include 'DIMENSIONS'
3877 include 'COMMON.GEO'
3878 include 'COMMON.VAR'
3879 include 'COMMON.LOCAL'
3880 include 'COMMON.CHAIN'
3881 include 'COMMON.DERIV'
3882 include 'COMMON.INTERACT'
3883 include 'COMMON.FFIELD'
3884 include 'COMMON.IOUNITS'
3888 cd print '(a)','Enter ESCP'
3889 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3890 c & ' scal14',scal14
3891 do i=iatscp_s,iatscp_e
3892 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3894 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3895 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3896 if (iteli.eq.0) goto 1225
3897 xi=0.5D0*(c(1,i)+c(1,i+1))
3898 yi=0.5D0*(c(2,i)+c(2,i+1))
3899 zi=0.5D0*(c(3,i)+c(3,i+1))
3900 C Returning the ith atom to box
3901 call to_box(xi,yi,zi)
3902 do iint=1,nscp_gr(i)
3904 do j=iscpstart(i,iint),iscpend(i,iint)
3905 itypj=iabs(itype(j))
3906 if (itypj.eq.ntyp1) cycle
3907 C Uncomment following three lines for SC-p interactions
3911 C Uncomment following three lines for Ca-p interactions
3915 C returning the jth atom to box
3916 call to_box(xj,yj,zj)
3917 xj=boxshift(xj-xi,boxxsize)
3918 yj=boxshift(yj-yi,boxysize)
3919 zj=boxshift(zj-zi,boxzsize)
3920 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3921 C sss is scaling function for smoothing the cutoff gradient otherwise
3922 C the gradient would not be continuouse
3923 sss=sscale(1.0d0/(dsqrt(rrij)))
3924 if (sss.le.0.0d0) cycle
3925 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3927 e1=fac*fac*aad(itypj,iteli)
3928 e2=fac*bad(itypj,iteli)
3929 if (iabs(j-i) .le. 2) then
3932 evdw2_14=evdw2_14+(e1+e2)*sss
3935 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3936 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3937 c & bad(itypj,iteli)
3938 evdw2=evdw2+evdwij*sss
3941 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3943 fac=-(evdwij+e1)*rrij*sss
3944 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3949 cd write (iout,*) 'j<i'
3950 C Uncomment following three lines for SC-p interactions
3952 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3955 cd write (iout,*) 'j>i'
3958 C Uncomment following line for SC-p interactions
3959 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3963 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3967 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3968 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3971 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3981 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3982 gradx_scp(j,i)=expon*gradx_scp(j,i)
3985 C******************************************************************************
3989 C To save time the factor EXPON has been extracted from ALL components
3990 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3993 C******************************************************************************
3996 C--------------------------------------------------------------------------
3997 subroutine edis(ehpb)
3999 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4001 implicit real*8 (a-h,o-z)
4002 include 'DIMENSIONS'
4003 include 'COMMON.SBRIDGE'
4004 include 'COMMON.CHAIN'
4005 include 'COMMON.DERIV'
4006 include 'COMMON.VAR'
4007 include 'COMMON.INTERACT'
4008 include 'COMMON.CONTROL'
4009 include 'COMMON.IOUNITS'
4010 dimension ggg(3),ggg_peak(3,1000)
4013 c 8/21/18 AL: added explicit restraints on reference coords
4014 c write (iout,*) "restr_on_coord",restr_on_coord
4015 if (restr_on_coord) then
4019 if (itype(i).eq.ntyp1) cycle
4021 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4022 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4024 if (itype(i).ne.10) then
4026 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4027 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4030 if (energy_dec) write (iout,*)
4031 & "i",i," bfac",bfac(i)," ecoor",ecoor
4032 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4036 C write (iout,*) ,"link_end",link_end,constr_dist
4037 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4038 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4039 c & " constr_dist",constr_dist
4040 if (link_end.eq.0.and.link_end_peak.eq.0) return
4041 do i=link_start_peak,link_end_peak
4043 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4044 c & ipeak(1,i),ipeak(2,i)
4045 do ip=ipeak(1,i),ipeak(2,i)
4050 C iii and jjj point to the residues for which the distance is assigned.
4051 c if (ii.gt.nres) then
4058 if (ii.gt.nres) then
4063 if (jj.gt.nres) then
4068 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4069 aux=dexp(-scal_peak*aux)
4070 ehpb_peak=ehpb_peak+aux
4071 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4072 & forcon_peak(ip))*aux/dd
4074 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4076 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4077 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4078 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4080 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4081 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4082 do ip=ipeak(1,i),ipeak(2,i)
4085 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4089 C iii and jjj point to the residues for which the distance is assigned.
4090 c if (ii.gt.nres) then
4097 if (ii.gt.nres) then
4102 if (jj.gt.nres) then
4109 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4114 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4118 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4119 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4123 do i=link_start,link_end
4124 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4125 C CA-CA distance used in regularization of structure.
4128 C iii and jjj point to the residues for which the distance is assigned.
4129 c if (ii.gt.nres) then
4136 if (ii.gt.nres) then
4141 if (jj.gt.nres) then
4146 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4147 c & dhpb(i),dhpb1(i),forcon(i)
4148 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4149 C distance and angle dependent SS bond potential.
4150 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4151 C & iabs(itype(jjj)).eq.1) then
4152 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4153 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4154 if (.not.dyn_ss .and. i.le.nss) then
4155 C 15/02/13 CC dynamic SSbond - additional check
4156 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4157 & iabs(itype(jjj)).eq.1) then
4158 call ssbond_ene(iii,jjj,eij)
4161 cd write (iout,*) "eij",eij
4162 cd & ' waga=',waga,' fac=',fac
4163 ! else if (ii.gt.nres .and. jj.gt.nres) then
4165 C Calculate the distance between the two points and its difference from the
4168 if (irestr_type(i).eq.11) then
4169 ehpb=ehpb+fordepth(i)!**4.0d0
4170 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4171 fac=fordepth(i)!**4.0d0
4172 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4173 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4174 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4175 & ehpb,irestr_type(i)
4176 else if (irestr_type(i).eq.10) then
4177 c AL 6//19/2018 cross-link restraints
4178 xdis = 0.5d0*(dd/forcon(i))**2
4179 expdis = dexp(-xdis)
4180 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4181 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4182 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4183 c & " wboltzd",wboltzd
4184 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4185 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4186 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4187 & *expdis/(aux*forcon(i)**2)
4188 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4189 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4190 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4191 else if (irestr_type(i).eq.2) then
4192 c Quartic restraints
4193 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4194 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4195 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4196 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4197 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4199 c Quadratic restraints
4201 C Get the force constant corresponding to this distance.
4203 C Calculate the contribution to energy.
4204 ehpb=ehpb+0.5d0*waga*rdis*rdis
4205 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4206 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4207 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4209 C Evaluate gradient.
4213 c Calculate Cartesian gradient
4215 ggg(j)=fac*(c(j,jj)-c(j,ii))
4217 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4218 C If this is a SC-SC distance, we need to calculate the contributions to the
4219 C Cartesian gradient in the SC vectors (ghpbx).
4222 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4227 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4231 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4232 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4238 C--------------------------------------------------------------------------
4239 subroutine ssbond_ene(i,j,eij)
4241 C Calculate the distance and angle dependent SS-bond potential energy
4242 C using a free-energy function derived based on RHF/6-31G** ab initio
4243 C calculations of diethyl disulfide.
4245 C A. Liwo and U. Kozlowska, 11/24/03
4247 implicit real*8 (a-h,o-z)
4248 include 'DIMENSIONS'
4249 include 'COMMON.SBRIDGE'
4250 include 'COMMON.CHAIN'
4251 include 'COMMON.DERIV'
4252 include 'COMMON.LOCAL'
4253 include 'COMMON.INTERACT'
4254 include 'COMMON.VAR'
4255 include 'COMMON.IOUNITS'
4256 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4257 itypi=iabs(itype(i))
4261 dxi=dc_norm(1,nres+i)
4262 dyi=dc_norm(2,nres+i)
4263 dzi=dc_norm(3,nres+i)
4264 dsci_inv=dsc_inv(itypi)
4265 itypj=iabs(itype(j))
4266 dscj_inv=dsc_inv(itypj)
4270 dxj=dc_norm(1,nres+j)
4271 dyj=dc_norm(2,nres+j)
4272 dzj=dc_norm(3,nres+j)
4273 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4278 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4279 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4280 om12=dxi*dxj+dyi*dyj+dzi*dzj
4282 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4283 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4289 deltat12=om2-om1+2.0d0
4291 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4292 & +akct*deltad*deltat12
4293 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4294 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4295 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4296 c & " deltat12",deltat12," eij",eij
4297 ed=2*akcm*deltad+akct*deltat12
4299 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4300 eom1=-2*akth*deltat1-pom1-om2*pom2
4301 eom2= 2*akth*deltat2+pom1-om1*pom2
4304 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4307 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4308 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4309 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4310 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4313 C Calculate the components of the gradient in DC and X
4317 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4322 C--------------------------------------------------------------------------
4323 subroutine ebond(estr)
4325 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4327 implicit real*8 (a-h,o-z)
4328 include 'DIMENSIONS'
4329 include 'COMMON.LOCAL'
4330 include 'COMMON.GEO'
4331 include 'COMMON.INTERACT'
4332 include 'COMMON.DERIV'
4333 include 'COMMON.VAR'
4334 include 'COMMON.CHAIN'
4335 include 'COMMON.IOUNITS'
4336 include 'COMMON.NAMES'
4337 include 'COMMON.FFIELD'
4338 include 'COMMON.CONTROL'
4339 double precision u(3),ud(3)
4342 c write (iout,*) "distchainmax",distchainmax
4345 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
4346 diff = vbld(i)-vbldp0
4348 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4349 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4351 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4352 C & *dc(j,i-1)/vbld(i)
4354 C if (energy_dec) write(iout,*)
4355 C & "estr1",i,vbld(i),distchainmax,
4356 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4358 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4359 diff = vbld(i)-vbldpDUM
4360 C write(iout,*) i,diff
4362 diff = vbld(i)-vbldp0
4363 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4366 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4367 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4370 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4373 C write (iout,'(a7,i5,4f7.3)')
4374 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4376 estr=0.5d0*AKP*estr+estr1
4378 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4382 if (iti.ne.10 .and. iti.ne.ntyp1) then
4385 diff=vbld(i+nres)-vbldsc0(1,iti)
4386 if (energy_dec) write (iout,*)
4387 & i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4388 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4389 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4391 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4395 diff=vbld(i+nres)-vbldsc0(j,iti)
4396 ud(j)=aksc(j,iti)*diff
4397 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4411 uprod2=uprod2*u(k)*u(k)
4415 usumsqder=usumsqder+ud(j)*uprod2
4417 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4418 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4419 estr=estr+uprod/usum
4421 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4429 C--------------------------------------------------------------------------
4430 subroutine ebend(etheta,ethetacnstr)
4432 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4433 C angles gamma and its derivatives in consecutive thetas and gammas.
4435 implicit real*8 (a-h,o-z)
4436 include 'DIMENSIONS'
4437 include 'COMMON.LOCAL'
4438 include 'COMMON.GEO'
4439 include 'COMMON.INTERACT'
4440 include 'COMMON.DERIV'
4441 include 'COMMON.VAR'
4442 include 'COMMON.CHAIN'
4443 include 'COMMON.IOUNITS'
4444 include 'COMMON.NAMES'
4445 include 'COMMON.FFIELD'
4446 include 'COMMON.TORCNSTR'
4447 common /calcthet/ term1,term2,termm,diffak,ratak,
4448 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4449 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4450 double precision y(2),z(2)
4452 c time11=dexp(-2*time)
4455 c write (iout,*) "nres",nres
4456 c write (*,'(a,i2)') 'EBEND ICG=',icg
4457 c write (iout,*) ithet_start,ithet_end
4458 do i=ithet_start,ithet_end
4459 C if (itype(i-1).eq.ntyp1) cycle
4461 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4462 & .or.itype(i).eq.ntyp1) cycle
4463 C Zero the energy function and its derivative at 0 or pi.
4464 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4466 ichir1=isign(1,itype(i-2))
4467 ichir2=isign(1,itype(i))
4468 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4469 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4470 if (itype(i-1).eq.10) then
4471 itype1=isign(10,itype(i-2))
4472 ichir11=isign(1,itype(i-2))
4473 ichir12=isign(1,itype(i-2))
4474 itype2=isign(10,itype(i))
4475 ichir21=isign(1,itype(i))
4476 ichir22=isign(1,itype(i))
4483 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4487 c call proc_proc(phii,icrc)
4488 if (icrc.eq.1) phii=150.0
4499 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4503 c call proc_proc(phii1,icrc)
4504 if (icrc.eq.1) phii1=150.0
4516 C Calculate the "mean" value of theta from the part of the distribution
4517 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4518 C In following comments this theta will be referred to as t_c.
4519 thet_pred_mean=0.0d0
4521 athetk=athet(k,it,ichir1,ichir2)
4522 bthetk=bthet(k,it,ichir1,ichir2)
4524 athetk=athet(k,itype1,ichir11,ichir12)
4525 bthetk=bthet(k,itype2,ichir21,ichir22)
4527 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4529 c write (iout,*) "thet_pred_mean",thet_pred_mean
4530 dthett=thet_pred_mean*ssd
4531 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4532 c write (iout,*) "thet_pred_mean",thet_pred_mean
4533 C Derivatives of the "mean" values in gamma1 and gamma2.
4534 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4535 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4536 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4537 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4539 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4540 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4541 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4542 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4544 if (theta(i).gt.pi-delta) then
4545 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4547 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4548 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4549 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4551 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4553 else if (theta(i).lt.delta) then
4554 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4555 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4556 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4558 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4559 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4562 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4565 etheta=etheta+ethetai
4566 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4567 c & 'ebend',i,ethetai,theta(i),itype(i)
4568 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4569 c & rad2deg*phii,rad2deg*phii1,ethetai
4570 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4571 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4572 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4576 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4577 do i=1,ntheta_constr
4578 itheta=itheta_constr(i)
4579 thetiii=theta(itheta)
4580 difi=pinorm(thetiii-theta_constr0(i))
4581 if (difi.gt.theta_drange(i)) then
4582 difi=difi-theta_drange(i)
4583 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4584 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4585 & +for_thet_constr(i)*difi**3
4586 else if (difi.lt.-drange(i)) then
4588 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4589 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4590 & +for_thet_constr(i)*difi**3
4594 C if (energy_dec) then
4595 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4596 C & i,itheta,rad2deg*thetiii,
4597 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4598 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4599 C & gloc(itheta+nphi-2,icg)
4602 C Ufff.... We've done all this!!!
4605 C---------------------------------------------------------------------------
4606 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4608 implicit real*8 (a-h,o-z)
4609 include 'DIMENSIONS'
4610 include 'COMMON.LOCAL'
4611 include 'COMMON.IOUNITS'
4612 common /calcthet/ term1,term2,termm,diffak,ratak,
4613 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4614 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4615 C Calculate the contributions to both Gaussian lobes.
4616 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4617 C The "polynomial part" of the "standard deviation" of this part of
4621 sig=sig*thet_pred_mean+polthet(j,it)
4623 C Derivative of the "interior part" of the "standard deviation of the"
4624 C gamma-dependent Gaussian lobe in t_c.
4625 sigtc=3*polthet(3,it)
4627 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4630 C Set the parameters of both Gaussian lobes of the distribution.
4631 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4632 fac=sig*sig+sigc0(it)
4635 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4636 sigsqtc=-4.0D0*sigcsq*sigtc
4637 c print *,i,sig,sigtc,sigsqtc
4638 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4639 sigtc=-sigtc/(fac*fac)
4640 C Following variable is sigma(t_c)**(-2)
4641 sigcsq=sigcsq*sigcsq
4643 sig0inv=1.0D0/sig0i**2
4644 delthec=thetai-thet_pred_mean
4645 delthe0=thetai-theta0i
4646 term1=-0.5D0*sigcsq*delthec*delthec
4647 term2=-0.5D0*sig0inv*delthe0*delthe0
4648 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4649 C NaNs in taking the logarithm. We extract the largest exponent which is added
4650 C to the energy (this being the log of the distribution) at the end of energy
4651 C term evaluation for this virtual-bond angle.
4652 if (term1.gt.term2) then
4654 term2=dexp(term2-termm)
4658 term1=dexp(term1-termm)
4661 C The ratio between the gamma-independent and gamma-dependent lobes of
4662 C the distribution is a Gaussian function of thet_pred_mean too.
4663 diffak=gthet(2,it)-thet_pred_mean
4664 ratak=diffak/gthet(3,it)**2
4665 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4666 C Let's differentiate it in thet_pred_mean NOW.
4668 C Now put together the distribution terms to make complete distribution.
4669 termexp=term1+ak*term2
4670 termpre=sigc+ak*sig0i
4671 C Contribution of the bending energy from this theta is just the -log of
4672 C the sum of the contributions from the two lobes and the pre-exponential
4673 C factor. Simple enough, isn't it?
4674 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4675 C NOW the derivatives!!!
4676 C 6/6/97 Take into account the deformation.
4677 E_theta=(delthec*sigcsq*term1
4678 & +ak*delthe0*sig0inv*term2)/termexp
4679 E_tc=((sigtc+aktc*sig0i)/termpre
4680 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4681 & aktc*term2)/termexp)
4684 c-----------------------------------------------------------------------------
4685 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4686 implicit real*8 (a-h,o-z)
4687 include 'DIMENSIONS'
4688 include 'COMMON.LOCAL'
4689 include 'COMMON.IOUNITS'
4690 common /calcthet/ term1,term2,termm,diffak,ratak,
4691 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4692 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4693 delthec=thetai-thet_pred_mean
4694 delthe0=thetai-theta0i
4695 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4696 t3 = thetai-thet_pred_mean
4700 t14 = t12+t6*sigsqtc
4702 t21 = thetai-theta0i
4708 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4709 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4710 & *(-t12*t9-ak*sig0inv*t27)
4714 C--------------------------------------------------------------------------
4715 subroutine ebend(etheta)
4717 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4718 C angles gamma and its derivatives in consecutive thetas and gammas.
4719 C ab initio-derived potentials from
4720 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4722 implicit real*8 (a-h,o-z)
4723 include 'DIMENSIONS'
4724 include 'COMMON.LOCAL'
4725 include 'COMMON.GEO'
4726 include 'COMMON.INTERACT'
4727 include 'COMMON.DERIV'
4728 include 'COMMON.VAR'
4729 include 'COMMON.CHAIN'
4730 include 'COMMON.IOUNITS'
4731 include 'COMMON.NAMES'
4732 include 'COMMON.FFIELD'
4733 include 'COMMON.CONTROL'
4734 include 'COMMON.TORCNSTR'
4735 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4736 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4737 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4738 & sinph1ph2(maxdouble,maxdouble)
4739 logical lprn /.false./, lprn1 /.false./
4741 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4742 do i=ithet_start,ithet_end
4744 C if (itype(i-1).eq.ntyp1) cycle
4746 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4747 & .or.itype(i).eq.ntyp1) cycle
4748 if (iabs(itype(i+1)).eq.20) iblock=2
4749 if (iabs(itype(i+1)).ne.20) iblock=1
4753 theti2=0.5d0*theta(i)
4754 ityp2=ithetyp((itype(i-1)))
4756 coskt(k)=dcos(k*theti2)
4757 sinkt(k)=dsin(k*theti2)
4767 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4770 if (phii.ne.phii) phii=150.0
4774 ityp1=ithetyp((itype(i-2)))
4776 cosph1(k)=dcos(k*phii)
4777 sinph1(k)=dsin(k*phii)
4783 ityp1=ithetyp((itype(i-2)))
4788 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4791 if (phii1.ne.phii1) phii1=150.0
4796 ityp3=ithetyp((itype(i)))
4798 cosph2(k)=dcos(k*phii1)
4799 sinph2(k)=dsin(k*phii1)
4804 ityp3=ithetyp((itype(i)))
4810 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4811 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4813 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4816 ccl=cosph1(l)*cosph2(k-l)
4817 ssl=sinph1(l)*sinph2(k-l)
4818 scl=sinph1(l)*cosph2(k-l)
4819 csl=cosph1(l)*sinph2(k-l)
4820 cosph1ph2(l,k)=ccl-ssl
4821 cosph1ph2(k,l)=ccl+ssl
4822 sinph1ph2(l,k)=scl+csl
4823 sinph1ph2(k,l)=scl-csl
4827 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4828 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4829 write (iout,*) "coskt and sinkt"
4831 write (iout,*) k,coskt(k),sinkt(k)
4835 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4836 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4839 & write (iout,*) "k",k,"
4840 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4841 & " ethetai",ethetai
4844 write (iout,*) "cosph and sinph"
4846 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4848 write (iout,*) "cosph1ph2 and sinph2ph2"
4851 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4852 & sinph1ph2(l,k),sinph1ph2(k,l)
4855 write(iout,*) "ethetai",ethetai
4859 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4860 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4861 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4862 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4863 ethetai=ethetai+sinkt(m)*aux
4864 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4865 dephii=dephii+k*sinkt(m)*(
4866 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4867 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4868 dephii1=dephii1+k*sinkt(m)*(
4869 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4870 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4872 & write (iout,*) "m",m," k",k," bbthet",
4873 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4874 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4875 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4876 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4880 & write(iout,*) "ethetai",ethetai
4884 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4885 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4886 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4887 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4888 ethetai=ethetai+sinkt(m)*aux
4889 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4890 dephii=dephii+l*sinkt(m)*(
4891 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4892 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4893 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4894 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4895 dephii1=dephii1+(k-l)*sinkt(m)*(
4896 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4897 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4898 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4899 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4901 write (iout,*) "m",m," k",k," l",l," ffthet",
4902 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4903 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4904 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4905 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4906 & " ethetai",ethetai
4907 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4908 & cosph1ph2(k,l)*sinkt(m),
4909 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4915 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4916 & i,theta(i)*rad2deg,phii*rad2deg,
4917 & phii1*rad2deg,ethetai
4918 etheta=etheta+ethetai
4919 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4920 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4921 c gloc(nphi+i-2,icg)=wang*dethetai
4922 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4928 c-----------------------------------------------------------------------------
4929 subroutine esc(escloc)
4930 C Calculate the local energy of a side chain and its derivatives in the
4931 C corresponding virtual-bond valence angles THETA and the spherical angles
4933 implicit real*8 (a-h,o-z)
4934 include 'DIMENSIONS'
4935 include 'COMMON.GEO'
4936 include 'COMMON.LOCAL'
4937 include 'COMMON.VAR'
4938 include 'COMMON.INTERACT'
4939 include 'COMMON.DERIV'
4940 include 'COMMON.CHAIN'
4941 include 'COMMON.IOUNITS'
4942 include 'COMMON.NAMES'
4943 include 'COMMON.FFIELD'
4944 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4945 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4946 common /sccalc/ time11,time12,time112,theti,it,nlobit
4949 C write (iout,*) 'ESC'
4950 do i=loc_start,loc_end
4952 if (it.eq.ntyp1) cycle
4953 if (it.eq.10) goto 1
4954 nlobit=nlob(iabs(it))
4955 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4956 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4957 theti=theta(i+1)-pipol
4961 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4963 if (x(2).gt.pi-delta) then
4967 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4969 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4970 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4972 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4973 & ddersc0(1),dersc(1))
4974 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4975 & ddersc0(3),dersc(3))
4977 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4979 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4980 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4981 & dersc0(2),esclocbi,dersc02)
4982 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4984 call splinthet(x(2),0.5d0*delta,ss,ssd)
4989 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4991 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4992 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4994 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4996 c write (iout,*) escloci
4997 else if (x(2).lt.delta) then
5001 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5003 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5004 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5006 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5007 & ddersc0(1),dersc(1))
5008 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5009 & ddersc0(3),dersc(3))
5011 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5013 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5014 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5015 & dersc0(2),esclocbi,dersc02)
5016 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5021 call splinthet(x(2),0.5d0*delta,ss,ssd)
5023 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5025 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5026 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5028 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5029 C write (iout,*) 'i=',i, escloci
5031 call enesc(x,escloci,dersc,ddummy,.false.)
5034 escloc=escloc+escloci
5035 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5036 write (iout,'(a6,i5,0pf7.3)')
5037 & 'escloc',i,escloci
5039 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5041 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5042 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5047 C---------------------------------------------------------------------------
5048 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5049 implicit real*8 (a-h,o-z)
5050 include 'DIMENSIONS'
5051 include 'COMMON.GEO'
5052 include 'COMMON.LOCAL'
5053 include 'COMMON.IOUNITS'
5054 common /sccalc/ time11,time12,time112,theti,it,nlobit
5055 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5056 double precision contr(maxlob,-1:1)
5058 c write (iout,*) 'it=',it,' nlobit=',nlobit
5062 if (mixed) ddersc(j)=0.0d0
5066 C Because of periodicity of the dependence of the SC energy in omega we have
5067 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5068 C To avoid underflows, first compute & store the exponents.
5076 z(k)=x(k)-censc(k,j,it)
5081 Axk=Axk+gaussc(l,k,j,it)*z(l)
5087 expfac=expfac+Ax(k,j,iii)*z(k)
5095 C As in the case of ebend, we want to avoid underflows in exponentiation and
5096 C subsequent NaNs and INFs in energy calculation.
5097 C Find the largest exponent
5101 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5105 cd print *,'it=',it,' emin=',emin
5107 C Compute the contribution to SC energy and derivatives
5111 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5112 cd print *,'j=',j,' expfac=',expfac
5113 escloc_i=escloc_i+expfac
5115 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5119 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5120 & +gaussc(k,2,j,it))*expfac
5127 dersc(1)=dersc(1)/cos(theti)**2
5128 ddersc(1)=ddersc(1)/cos(theti)**2
5131 escloci=-(dlog(escloc_i)-emin)
5133 dersc(j)=dersc(j)/escloc_i
5137 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5142 C------------------------------------------------------------------------------
5143 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5144 implicit real*8 (a-h,o-z)
5145 include 'DIMENSIONS'
5146 include 'COMMON.GEO'
5147 include 'COMMON.LOCAL'
5148 include 'COMMON.IOUNITS'
5149 common /sccalc/ time11,time12,time112,theti,it,nlobit
5150 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5151 double precision contr(maxlob)
5162 z(k)=x(k)-censc(k,j,it)
5168 Axk=Axk+gaussc(l,k,j,it)*z(l)
5174 expfac=expfac+Ax(k,j)*z(k)
5179 C As in the case of ebend, we want to avoid underflows in exponentiation and
5180 C subsequent NaNs and INFs in energy calculation.
5181 C Find the largest exponent
5184 if (emin.gt.contr(j)) emin=contr(j)
5188 C Compute the contribution to SC energy and derivatives
5192 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5193 escloc_i=escloc_i+expfac
5195 dersc(k)=dersc(k)+Ax(k,j)*expfac
5197 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5198 & +gaussc(1,2,j,it))*expfac
5202 dersc(1)=dersc(1)/cos(theti)**2
5203 dersc12=dersc12/cos(theti)**2
5204 escloci=-(dlog(escloc_i)-emin)
5206 dersc(j)=dersc(j)/escloc_i
5208 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5212 c----------------------------------------------------------------------------------
5213 subroutine esc(escloc)
5214 C Calculate the local energy of a side chain and its derivatives in the
5215 C corresponding virtual-bond valence angles THETA and the spherical angles
5216 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5217 C added by Urszula Kozlowska. 07/11/2007
5219 implicit real*8 (a-h,o-z)
5220 include 'DIMENSIONS'
5221 include 'COMMON.GEO'
5222 include 'COMMON.LOCAL'
5223 include 'COMMON.VAR'
5224 include 'COMMON.SCROT'
5225 include 'COMMON.INTERACT'
5226 include 'COMMON.DERIV'
5227 include 'COMMON.CHAIN'
5228 include 'COMMON.IOUNITS'
5229 include 'COMMON.NAMES'
5230 include 'COMMON.FFIELD'
5231 include 'COMMON.CONTROL'
5232 include 'COMMON.VECTORS'
5233 double precision x_prime(3),y_prime(3),z_prime(3)
5234 & , sumene,dsc_i,dp2_i,x(65),
5235 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5236 & de_dxx,de_dyy,de_dzz,de_dt
5237 double precision s1_t,s1_6_t,s2_t,s2_6_t
5239 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5240 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5241 & dt_dCi(3),dt_dCi1(3)
5242 common /sccalc/ time11,time12,time112,theti,it,nlobit
5245 do i=loc_start,loc_end
5246 if (itype(i).eq.ntyp1) cycle
5247 costtab(i+1) =dcos(theta(i+1))
5248 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5249 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5250 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5251 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5252 cosfac=dsqrt(cosfac2)
5253 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5254 sinfac=dsqrt(sinfac2)
5256 if (it.eq.10) goto 1
5258 C Compute the axes of tghe local cartesian coordinates system; store in
5259 c x_prime, y_prime and z_prime
5266 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5267 C & dc_norm(3,i+nres)
5269 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5270 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5273 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5276 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5277 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5278 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5279 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5280 c & " xy",scalar(x_prime(1),y_prime(1)),
5281 c & " xz",scalar(x_prime(1),z_prime(1)),
5282 c & " yy",scalar(y_prime(1),y_prime(1)),
5283 c & " yz",scalar(y_prime(1),z_prime(1)),
5284 c & " zz",scalar(z_prime(1),z_prime(1))
5286 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5287 C to local coordinate system. Store in xx, yy, zz.
5293 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5294 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5295 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5302 C Compute the energy of the ith side cbain
5304 c write (2,*) "xx",xx," yy",yy," zz",zz
5307 x(j) = sc_parmin(j,it)
5310 Cc diagnostics - remove later
5312 yy1 = dsin(alph(2))*dcos(omeg(2))
5313 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5314 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5315 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5317 C," --- ", xx_w,yy_w,zz_w
5320 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5321 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5323 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5324 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5326 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5327 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5328 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5329 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5330 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5332 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5333 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5334 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5335 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5336 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5338 dsc_i = 0.743d0+x(61)
5340 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5341 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5342 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5343 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5344 s1=(1+x(63))/(0.1d0 + dscp1)
5345 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5346 s2=(1+x(65))/(0.1d0 + dscp2)
5347 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5348 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5349 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5350 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5352 c & dscp1,dscp2,sumene
5353 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5354 escloc = escloc + sumene
5355 c write (2,*) "escloc",escloc
5356 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5358 if (.not. calc_grad) goto 1
5361 C This section to check the numerical derivatives of the energy of ith side
5362 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5363 C #define DEBUG in the code to turn it on.
5365 write (2,*) "sumene =",sumene
5369 write (2,*) xx,yy,zz
5370 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5371 de_dxx_num=(sumenep-sumene)/aincr
5373 write (2,*) "xx+ sumene from enesc=",sumenep
5376 write (2,*) xx,yy,zz
5377 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5378 de_dyy_num=(sumenep-sumene)/aincr
5380 write (2,*) "yy+ sumene from enesc=",sumenep
5383 write (2,*) xx,yy,zz
5384 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5385 de_dzz_num=(sumenep-sumene)/aincr
5387 write (2,*) "zz+ sumene from enesc=",sumenep
5388 costsave=cost2tab(i+1)
5389 sintsave=sint2tab(i+1)
5390 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5391 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5392 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5393 de_dt_num=(sumenep-sumene)/aincr
5394 write (2,*) " t+ sumene from enesc=",sumenep
5395 cost2tab(i+1)=costsave
5396 sint2tab(i+1)=sintsave
5397 C End of diagnostics section.
5400 C Compute the gradient of esc
5402 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5403 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5404 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5405 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5406 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5407 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5408 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5409 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5410 pom1=(sumene3*sint2tab(i+1)+sumene1)
5411 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5412 pom2=(sumene4*cost2tab(i+1)+sumene2)
5413 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5414 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5415 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5416 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5418 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5419 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5420 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5422 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5423 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5424 & +(pom1+pom2)*pom_dx
5426 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5429 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5430 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5431 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5433 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5434 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5435 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5436 & +x(59)*zz**2 +x(60)*xx*zz
5437 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5438 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5439 & +(pom1-pom2)*pom_dy
5441 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5444 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5445 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5446 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5447 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5448 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5449 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5450 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5451 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5453 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5456 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5457 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5458 & +pom1*pom_dt1+pom2*pom_dt2
5460 write(2,*), "de_dt = ", de_dt,de_dt_num
5464 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5465 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5466 cosfac2xx=cosfac2*xx
5467 sinfac2yy=sinfac2*yy
5469 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5471 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5473 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5474 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5475 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5476 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5477 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5478 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5479 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5480 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5481 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5482 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5486 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5487 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5488 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5489 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5492 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5493 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5494 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5496 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5497 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5501 dXX_Ctab(k,i)=dXX_Ci(k)
5502 dXX_C1tab(k,i)=dXX_Ci1(k)
5503 dYY_Ctab(k,i)=dYY_Ci(k)
5504 dYY_C1tab(k,i)=dYY_Ci1(k)
5505 dZZ_Ctab(k,i)=dZZ_Ci(k)
5506 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5507 dXX_XYZtab(k,i)=dXX_XYZ(k)
5508 dYY_XYZtab(k,i)=dYY_XYZ(k)
5509 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5513 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5514 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5515 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5516 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5517 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5519 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5520 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5521 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5522 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5523 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5524 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5525 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5526 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5528 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5529 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5531 C to check gradient call subroutine check_grad
5538 c------------------------------------------------------------------------------
5539 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5541 C This procedure calculates two-body contact function g(rij) and its derivative:
5544 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5547 C where x=(rij-r0ij)/delta
5549 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5552 double precision rij,r0ij,eps0ij,fcont,fprimcont
5553 double precision x,x2,x4,delta
5557 if (x.lt.-1.0D0) then
5560 else if (x.le.1.0D0) then
5563 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5564 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5571 c------------------------------------------------------------------------------
5572 subroutine splinthet(theti,delta,ss,ssder)
5573 implicit real*8 (a-h,o-z)
5574 include 'DIMENSIONS'
5575 include 'COMMON.VAR'
5576 include 'COMMON.GEO'
5579 if (theti.gt.pipol) then
5580 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5582 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5587 c------------------------------------------------------------------------------
5588 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5590 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5591 double precision ksi,ksi2,ksi3,a1,a2,a3
5592 a1=fprim0*delta/(f1-f0)
5598 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5599 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5602 c------------------------------------------------------------------------------
5603 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5605 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5606 double precision ksi,ksi2,ksi3,a1,a2,a3
5611 a2=3*(f1x-f0x)-2*fprim0x*delta
5612 a3=fprim0x*delta-2*(f1x-f0x)
5613 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5616 C-----------------------------------------------------------------------------
5618 C-----------------------------------------------------------------------------
5619 subroutine etor(etors,fact)
5620 implicit real*8 (a-h,o-z)
5621 include 'DIMENSIONS'
5622 include 'COMMON.VAR'
5623 include 'COMMON.GEO'
5624 include 'COMMON.LOCAL'
5625 include 'COMMON.TORSION'
5626 include 'COMMON.INTERACT'
5627 include 'COMMON.DERIV'
5628 include 'COMMON.CHAIN'
5629 include 'COMMON.NAMES'
5630 include 'COMMON.IOUNITS'
5631 include 'COMMON.FFIELD'
5632 include 'COMMON.TORCNSTR'
5634 C Set lprn=.true. for debugging
5638 do i=iphi_start,iphi_end
5639 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5640 & .or. itype(i).eq.ntyp1) cycle
5641 itori=itortyp(itype(i-2))
5642 itori1=itortyp(itype(i-1))
5645 C Proline-Proline pair is a special case...
5646 if (itori.eq.3 .and. itori1.eq.3) then
5647 if (phii.gt.-dwapi3) then
5649 fac=1.0D0/(1.0D0-cosphi)
5650 etorsi=v1(1,3,3)*fac
5651 etorsi=etorsi+etorsi
5652 etors=etors+etorsi-v1(1,3,3)
5653 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5656 v1ij=v1(j+1,itori,itori1)
5657 v2ij=v2(j+1,itori,itori1)
5660 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5661 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5665 v1ij=v1(j,itori,itori1)
5666 v2ij=v2(j,itori,itori1)
5669 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5670 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5674 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5675 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5676 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5677 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5678 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5682 c------------------------------------------------------------------------------
5684 subroutine etor(etors,fact)
5685 implicit real*8 (a-h,o-z)
5686 include 'DIMENSIONS'
5687 include 'COMMON.VAR'
5688 include 'COMMON.GEO'
5689 include 'COMMON.LOCAL'
5690 include 'COMMON.TORSION'
5691 include 'COMMON.INTERACT'
5692 include 'COMMON.DERIV'
5693 include 'COMMON.CHAIN'
5694 include 'COMMON.NAMES'
5695 include 'COMMON.IOUNITS'
5696 include 'COMMON.FFIELD'
5697 include 'COMMON.TORCNSTR'
5699 C Set lprn=.true. for debugging
5703 do i=iphi_start,iphi_end
5705 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5706 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5707 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5708 C & .or. itype(i).eq.ntyp1) cycle
5709 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5710 if (iabs(itype(i)).eq.20) then
5715 itori=itortyp(itype(i-2))
5716 itori1=itortyp(itype(i-1))
5719 C Regular cosine and sine terms
5720 do j=1,nterm(itori,itori1,iblock)
5721 v1ij=v1(j,itori,itori1,iblock)
5722 v2ij=v2(j,itori,itori1,iblock)
5725 etors=etors+v1ij*cosphi+v2ij*sinphi
5726 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5730 C E = SUM ----------------------------------- - v1
5731 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5733 cosphi=dcos(0.5d0*phii)
5734 sinphi=dsin(0.5d0*phii)
5735 do j=1,nlor(itori,itori1,iblock)
5736 vl1ij=vlor1(j,itori,itori1)
5737 vl2ij=vlor2(j,itori,itori1)
5738 vl3ij=vlor3(j,itori,itori1)
5739 pom=vl2ij*cosphi+vl3ij*sinphi
5740 pom1=1.0d0/(pom*pom+1.0d0)
5741 etors=etors+vl1ij*pom1
5742 c if (energy_dec) etors_ii=etors_ii+
5745 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5747 C Subtract the constant term
5748 etors=etors-v0(itori,itori1,iblock)
5750 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5751 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5752 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5753 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5754 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5759 c----------------------------------------------------------------------------
5760 subroutine etor_d(etors_d,fact2)
5761 C 6/23/01 Compute double torsional energy
5762 implicit real*8 (a-h,o-z)
5763 include 'DIMENSIONS'
5764 include 'COMMON.VAR'
5765 include 'COMMON.GEO'
5766 include 'COMMON.LOCAL'
5767 include 'COMMON.TORSION'
5768 include 'COMMON.INTERACT'
5769 include 'COMMON.DERIV'
5770 include 'COMMON.CHAIN'
5771 include 'COMMON.NAMES'
5772 include 'COMMON.IOUNITS'
5773 include 'COMMON.FFIELD'
5774 include 'COMMON.TORCNSTR'
5776 C Set lprn=.true. for debugging
5780 do i=iphi_start,iphi_end-1
5782 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5783 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5784 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5785 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5786 & (itype(i+1).eq.ntyp1)) cycle
5787 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5789 itori=itortyp(itype(i-2))
5790 itori1=itortyp(itype(i-1))
5791 itori2=itortyp(itype(i))
5797 if (iabs(itype(i+1)).eq.20) iblock=2
5798 C Regular cosine and sine terms
5799 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5800 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5801 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5802 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5803 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5804 cosphi1=dcos(j*phii)
5805 sinphi1=dsin(j*phii)
5806 cosphi2=dcos(j*phii1)
5807 sinphi2=dsin(j*phii1)
5808 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5809 & v2cij*cosphi2+v2sij*sinphi2
5810 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5811 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5813 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5815 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5816 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5817 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5818 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5819 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5820 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5821 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5822 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5823 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5824 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5825 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5826 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5827 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5828 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5831 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5832 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5838 c---------------------------------------------------------------------------
5839 C The rigorous attempt to derive energy function
5840 subroutine etor_kcc(etors,fact)
5841 implicit real*8 (a-h,o-z)
5842 include 'DIMENSIONS'
5843 include 'COMMON.VAR'
5844 include 'COMMON.GEO'
5845 include 'COMMON.LOCAL'
5846 include 'COMMON.TORSION'
5847 include 'COMMON.INTERACT'
5848 include 'COMMON.DERIV'
5849 include 'COMMON.CHAIN'
5850 include 'COMMON.NAMES'
5851 include 'COMMON.IOUNITS'
5852 include 'COMMON.FFIELD'
5853 include 'COMMON.TORCNSTR'
5854 include 'COMMON.CONTROL'
5855 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
5857 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
5858 C Set lprn=.true. for debugging
5861 C print *,"wchodze kcc"
5862 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
5864 do i=iphi_start,iphi_end
5865 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5866 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5867 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5868 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5869 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5870 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5871 itori=itortyp(itype(i-2))
5872 itori1=itortyp(itype(i-1))
5877 C to avoid multiple devision by 2
5878 c theti22=0.5d0*theta(i)
5879 C theta 12 is the theta_1 /2
5880 C theta 22 is theta_2 /2
5881 c theti12=0.5d0*theta(i-1)
5882 C and appropriate sinus function
5883 sinthet1=dsin(theta(i-1))
5884 sinthet2=dsin(theta(i))
5885 costhet1=dcos(theta(i-1))
5886 costhet2=dcos(theta(i))
5887 C to speed up lets store its mutliplication
5888 sint1t2=sinthet2*sinthet1
5890 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
5891 C +d_n*sin(n*gamma)) *
5892 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
5893 C we have two sum 1) Non-Chebyshev which is with n and gamma
5894 nval=nterm_kcc_Tb(itori,itori1)
5900 c1(j)=c1(j-1)*costhet1
5901 c2(j)=c2(j-1)*costhet2
5904 do j=1,nterm_kcc(itori,itori1)
5908 sint1t2n=sint1t2n*sint1t2
5914 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5915 gradvalct1=gradvalct1+
5916 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5917 gradvalct2=gradvalct2+
5918 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5921 gradvalct1=-gradvalct1*sinthet1
5922 gradvalct2=-gradvalct2*sinthet2
5928 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5929 gradvalst1=gradvalst1+
5930 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5931 gradvalst2=gradvalst2+
5932 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5935 gradvalst1=-gradvalst1*sinthet1
5936 gradvalst2=-gradvalst2*sinthet2
5937 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
5938 C glocig is the gradient local i site in gamma
5939 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
5940 C now gradient over theta_1
5941 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
5942 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
5943 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
5944 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
5947 C derivative over gamma
5948 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
5949 C derivative over theta1
5950 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
5951 C now derivative over theta2
5952 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
5954 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
5955 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
5959 c---------------------------------------------------------------------------------------------
5960 subroutine etor_constr(edihcnstr)
5961 implicit real*8 (a-h,o-z)
5962 include 'DIMENSIONS'
5963 include 'COMMON.VAR'
5964 include 'COMMON.GEO'
5965 include 'COMMON.LOCAL'
5966 include 'COMMON.TORSION'
5967 include 'COMMON.INTERACT'
5968 include 'COMMON.DERIV'
5969 include 'COMMON.CHAIN'
5970 include 'COMMON.NAMES'
5971 include 'COMMON.IOUNITS'
5972 include 'COMMON.FFIELD'
5973 include 'COMMON.TORCNSTR'
5974 include 'COMMON.CONTROL'
5975 ! 6/20/98 - dihedral angle constraints
5977 c do i=1,ndih_constr
5978 c write (iout,*) "idihconstr_start",idihconstr_start,
5979 c & " idihconstr_end",idihconstr_end
5980 if (raw_psipred) then
5981 do i=idihconstr_start,idihconstr_end
5982 itori=idih_constr(i)
5984 gaudih_i=vpsipred(1,i)
5988 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
5989 dexpcos_i=dexp(-cos_i*cos_i)
5990 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
5991 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
5992 & *cos_i*dexpcos_i/s**2
5994 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
5995 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
5997 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
5998 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
5999 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6000 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6001 & -wdihc*dlog(gaudih_i)
6004 do i=idihconstr_start,idihconstr_end
6005 itori=idih_constr(i)
6007 difi=pinorm(phii-phi0(i))
6008 if (difi.gt.drange(i)) then
6010 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6011 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6012 else if (difi.lt.-drange(i)) then
6014 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6015 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6023 c----------------------------------------------------------------------------
6024 C The rigorous attempt to derive energy function
6025 subroutine ebend_kcc(etheta)
6027 implicit real*8 (a-h,o-z)
6028 include 'DIMENSIONS'
6029 include 'COMMON.VAR'
6030 include 'COMMON.GEO'
6031 include 'COMMON.LOCAL'
6032 include 'COMMON.TORSION'
6033 include 'COMMON.INTERACT'
6034 include 'COMMON.DERIV'
6035 include 'COMMON.CHAIN'
6036 include 'COMMON.NAMES'
6037 include 'COMMON.IOUNITS'
6038 include 'COMMON.FFIELD'
6039 include 'COMMON.TORCNSTR'
6040 include 'COMMON.CONTROL'
6042 double precision thybt1(maxang_kcc)
6043 C Set lprn=.true. for debugging
6046 C print *,"wchodze kcc"
6047 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6049 do i=ithet_start,ithet_end
6050 c print *,i,itype(i-1),itype(i),itype(i-2)
6051 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6052 & .or.itype(i).eq.ntyp1) cycle
6053 iti=iabs(itortyp(itype(i-1)))
6054 sinthet=dsin(theta(i))
6055 costhet=dcos(theta(i))
6056 do j=1,nbend_kcc_Tb(iti)
6057 thybt1(j)=v1bend_chyb(j,iti)
6059 sumth1thyb=v1bend_chyb(0,iti)+
6060 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6061 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6063 ihelp=nbend_kcc_Tb(iti)-1
6064 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6065 etheta=etheta+sumth1thyb
6066 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6067 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6071 c-------------------------------------------------------------------------------------
6072 subroutine etheta_constr(ethetacnstr)
6074 implicit real*8 (a-h,o-z)
6075 include 'DIMENSIONS'
6076 include 'COMMON.VAR'
6077 include 'COMMON.GEO'
6078 include 'COMMON.LOCAL'
6079 include 'COMMON.TORSION'
6080 include 'COMMON.INTERACT'
6081 include 'COMMON.DERIV'
6082 include 'COMMON.CHAIN'
6083 include 'COMMON.NAMES'
6084 include 'COMMON.IOUNITS'
6085 include 'COMMON.FFIELD'
6086 include 'COMMON.TORCNSTR'
6087 include 'COMMON.CONTROL'
6089 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6090 do i=ithetaconstr_start,ithetaconstr_end
6091 itheta=itheta_constr(i)
6092 thetiii=theta(itheta)
6093 difi=pinorm(thetiii-theta_constr0(i))
6094 if (difi.gt.theta_drange(i)) then
6095 difi=difi-theta_drange(i)
6096 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6097 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6098 & +for_thet_constr(i)*difi**3
6099 else if (difi.lt.-drange(i)) then
6101 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6102 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6103 & +for_thet_constr(i)*difi**3
6107 if (energy_dec) then
6108 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6109 & i,itheta,rad2deg*thetiii,
6110 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6111 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6112 & gloc(itheta+nphi-2,icg)
6117 c------------------------------------------------------------------------------
6118 c------------------------------------------------------------------------------
6119 subroutine eback_sc_corr(esccor)
6120 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6121 c conformational states; temporarily implemented as differences
6122 c between UNRES torsional potentials (dependent on three types of
6123 c residues) and the torsional potentials dependent on all 20 types
6124 c of residues computed from AM1 energy surfaces of terminally-blocked
6125 c amino-acid residues.
6126 implicit real*8 (a-h,o-z)
6127 include 'DIMENSIONS'
6128 include 'COMMON.VAR'
6129 include 'COMMON.GEO'
6130 include 'COMMON.LOCAL'
6131 include 'COMMON.TORSION'
6132 include 'COMMON.SCCOR'
6133 include 'COMMON.INTERACT'
6134 include 'COMMON.DERIV'
6135 include 'COMMON.CHAIN'
6136 include 'COMMON.NAMES'
6137 include 'COMMON.IOUNITS'
6138 include 'COMMON.FFIELD'
6139 include 'COMMON.CONTROL'
6141 C Set lprn=.true. for debugging
6144 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6146 do i=itau_start,itau_end
6147 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6149 isccori=isccortyp(itype(i-2))
6150 isccori1=isccortyp(itype(i-1))
6152 do intertyp=1,3 !intertyp
6153 cc Added 09 May 2012 (Adasko)
6154 cc Intertyp means interaction type of backbone mainchain correlation:
6155 c 1 = SC...Ca...Ca...Ca
6156 c 2 = Ca...Ca...Ca...SC
6157 c 3 = SC...Ca...Ca...SCi
6159 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6160 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6161 & (itype(i-1).eq.ntyp1)))
6162 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6163 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6164 & .or.(itype(i).eq.ntyp1)))
6165 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6166 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6167 & (itype(i-3).eq.ntyp1)))) cycle
6168 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6169 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6171 do j=1,nterm_sccor(isccori,isccori1)
6172 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6173 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6174 cosphi=dcos(j*tauangle(intertyp,i))
6175 sinphi=dsin(j*tauangle(intertyp,i))
6176 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6177 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6179 C write (iout,*)"EBACK_SC_COR",esccor,i
6180 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6181 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6182 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6184 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6185 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6186 & (v1sccor(j,1,itori,itori1),j=1,6)
6187 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6188 c gsccor_loc(i-3)=gloci
6194 c------------------------------------------------------------------------------
6195 subroutine multibody(ecorr)
6196 C This subroutine calculates multi-body contributions to energy following
6197 C the idea of Skolnick et al. If side chains I and J make a contact and
6198 C at the same time side chains I+1 and J+1 make a contact, an extra
6199 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6200 implicit real*8 (a-h,o-z)
6201 include 'DIMENSIONS'
6202 include 'COMMON.IOUNITS'
6203 include 'COMMON.DERIV'
6204 include 'COMMON.INTERACT'
6205 include 'COMMON.CONTACTS'
6206 include 'COMMON.CONTMAT'
6207 include 'COMMON.CORRMAT'
6208 double precision gx(3),gx1(3)
6211 C Set lprn=.true. for debugging
6215 write (iout,'(a)') 'Contact function values:'
6217 write (iout,'(i2,20(1x,i2,f10.5))')
6218 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6233 num_conti=num_cont(i)
6234 num_conti1=num_cont(i1)
6239 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6240 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6241 cd & ' ishift=',ishift
6242 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6243 C The system gains extra energy.
6244 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6245 endif ! j1==j+-ishift
6254 c------------------------------------------------------------------------------
6255 double precision function esccorr(i,j,k,l,jj,kk)
6256 implicit real*8 (a-h,o-z)
6257 include 'DIMENSIONS'
6258 include 'COMMON.IOUNITS'
6259 include 'COMMON.DERIV'
6260 include 'COMMON.INTERACT'
6261 include 'COMMON.CONTACTS'
6262 include 'COMMON.CONTMAT'
6263 include 'COMMON.CORRMAT'
6264 double precision gx(3),gx1(3)
6269 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6270 C Calculate the multi-body contribution to energy.
6271 C Calculate multi-body contributions to the gradient.
6272 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6273 cd & k,l,(gacont(m,kk,k),m=1,3)
6275 gx(m) =ekl*gacont(m,jj,i)
6276 gx1(m)=eij*gacont(m,kk,k)
6277 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6278 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6279 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6280 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6284 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6289 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6295 c------------------------------------------------------------------------------
6296 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6297 C This subroutine calculates multi-body contributions to hydrogen-bonding
6298 implicit real*8 (a-h,o-z)
6299 include 'DIMENSIONS'
6300 include 'COMMON.IOUNITS'
6301 include 'COMMON.FFIELD'
6302 include 'COMMON.DERIV'
6303 include 'COMMON.INTERACT'
6304 include 'COMMON.CONTACTS'
6305 include 'COMMON.CONTMAT'
6306 include 'COMMON.CORRMAT'
6307 double precision gx(3),gx1(3)
6310 C Set lprn=.true. for debugging
6313 write (iout,'(a)') 'Contact function values:'
6315 write (iout,'(2i3,50(1x,i2,f5.2))')
6316 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6317 & j=1,num_cont_hb(i))
6321 C Remove the loop below after debugging !!!
6328 C Calculate the local-electrostatic correlation terms
6329 do i=iatel_s,iatel_e+1
6331 num_conti=num_cont_hb(i)
6332 num_conti1=num_cont_hb(i+1)
6337 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6338 c & ' jj=',jj,' kk=',kk
6339 if (j1.eq.j+1 .or. j1.eq.j-1) then
6340 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6341 C The system gains extra energy.
6342 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6344 else if (j1.eq.j) then
6345 C Contacts I-J and I-(J+1) occur simultaneously.
6346 C The system loses extra energy.
6347 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6352 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6353 c & ' jj=',jj,' kk=',kk
6355 C Contacts I-J and (I+1)-J occur simultaneously.
6356 C The system loses extra energy.
6357 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6364 c------------------------------------------------------------------------------
6365 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6367 C This subroutine calculates multi-body contributions to hydrogen-bonding
6368 implicit real*8 (a-h,o-z)
6369 include 'DIMENSIONS'
6370 include 'COMMON.IOUNITS'
6374 include 'COMMON.FFIELD'
6375 include 'COMMON.DERIV'
6376 include 'COMMON.LOCAL'
6377 include 'COMMON.INTERACT'
6378 include 'COMMON.CONTACTS'
6379 include 'COMMON.CONTMAT'
6380 include 'COMMON.CORRMAT'
6381 include 'COMMON.CHAIN'
6382 include 'COMMON.CONTROL'
6383 include 'COMMON.SHIELD'
6384 double precision gx(3),gx1(3)
6385 integer num_cont_hb_old(maxres)
6387 double precision eello4,eello5,eelo6,eello_turn6
6388 external eello4,eello5,eello6,eello_turn6
6389 C Set lprn=.true. for debugging
6393 write (iout,'(a)') 'Contact function values:'
6395 write (iout,'(2i3,50(1x,i2,5f6.3))')
6396 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6397 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6403 C Remove the loop below after debugging !!!
6410 C Calculate the dipole-dipole interaction energies
6411 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6412 do i=iatel_s,iatel_e+1
6413 num_conti=num_cont_hb(i)
6422 C Calculate the local-electrostatic correlation terms
6423 c write (iout,*) "gradcorr5 in eello5 before loop"
6425 c write (iout,'(i5,3f10.5)')
6426 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6428 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6429 c write (iout,*) "corr loop i",i
6431 num_conti=num_cont_hb(i)
6432 num_conti1=num_cont_hb(i+1)
6439 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6440 c & ' jj=',jj,' kk=',kk
6441 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6442 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6443 & .or. j.lt.0 .and. j1.gt.0) .and.
6444 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6445 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6446 C The system gains extra energy.
6448 sqd1=dsqrt(d_cont(jj,i))
6449 sqd2=dsqrt(d_cont(kk,i1))
6450 sred_geom = sqd1*sqd2
6451 IF (sred_geom.lt.cutoff_corr) THEN
6452 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6454 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6455 cd & ' jj=',jj,' kk=',kk
6456 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6457 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6459 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6460 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6463 cd write (iout,*) 'sred_geom=',sred_geom,
6464 cd & ' ekont=',ekont,' fprim=',fprimcont,
6465 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6466 cd write (iout,*) "g_contij",g_contij
6467 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6468 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6469 call calc_eello(i,jp,i+1,jp1,jj,kk)
6470 if (wcorr4.gt.0.0d0)
6471 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6472 CC & *fac_shield(i)**2*fac_shield(j)**2
6473 if (energy_dec.and.wcorr4.gt.0.0d0)
6474 1 write (iout,'(a6,4i5,0pf7.3)')
6475 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6476 c write (iout,*) "gradcorr5 before eello5"
6478 c write (iout,'(i5,3f10.5)')
6479 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6481 if (wcorr5.gt.0.0d0)
6482 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6483 c write (iout,*) "gradcorr5 after eello5"
6485 c write (iout,'(i5,3f10.5)')
6486 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6488 if (energy_dec.and.wcorr5.gt.0.0d0)
6489 1 write (iout,'(a6,4i5,0pf7.3)')
6490 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6491 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6492 cd write(2,*)'ijkl',i,jp,i+1,jp1
6493 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6494 & .or. wturn6.eq.0.0d0))then
6495 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6496 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6497 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6498 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6499 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6500 cd & 'ecorr6=',ecorr6
6501 cd write (iout,'(4e15.5)') sred_geom,
6502 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6503 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6504 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6505 else if (wturn6.gt.0.0d0
6506 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6507 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6508 eturn6=eturn6+eello_turn6(i,jj,kk)
6509 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6510 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6511 cd write (2,*) 'multibody_eello:eturn6',eturn6
6520 num_cont_hb(i)=num_cont_hb_old(i)
6522 c write (iout,*) "gradcorr5 in eello5"
6524 c write (iout,'(i5,3f10.5)')
6525 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6529 c------------------------------------------------------------------------------
6530 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6531 implicit real*8 (a-h,o-z)
6532 include 'DIMENSIONS'
6533 include 'COMMON.IOUNITS'
6534 include 'COMMON.DERIV'
6535 include 'COMMON.INTERACT'
6536 include 'COMMON.CONTACTS'
6537 include 'COMMON.CONTMAT'
6538 include 'COMMON.CORRMAT'
6539 include 'COMMON.SHIELD'
6540 include 'COMMON.CONTROL'
6541 double precision gx(3),gx1(3)
6544 C print *,"wchodze",fac_shield(i),shield_mode
6552 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6554 C & fac_shield(i)**2*fac_shield(j)**2
6555 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6556 C Following 4 lines for diagnostics.
6561 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6562 c & 'Contacts ',i,j,
6563 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6564 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6566 C Calculate the multi-body contribution to energy.
6567 C ecorr=ecorr+ekont*ees
6568 C Calculate multi-body contributions to the gradient.
6569 coeffpees0pij=coeffp*ees0pij
6570 coeffmees0mij=coeffm*ees0mij
6571 coeffpees0pkl=coeffp*ees0pkl
6572 coeffmees0mkl=coeffm*ees0mkl
6574 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6575 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6576 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6577 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6578 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6579 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6580 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6581 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6582 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6583 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6584 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6585 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6586 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6587 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6588 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6589 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6590 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6591 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6592 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6593 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6594 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6595 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6596 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6597 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6598 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6603 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6604 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6605 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6606 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6611 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6612 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6613 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6614 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6617 c write (iout,*) "ehbcorr",ekont*ees
6618 C print *,ekont,ees,i,k
6620 C now gradient over shielding
6622 if (shield_mode.gt.0) then
6625 C print *,i,j,fac_shield(i),fac_shield(j),
6626 C &fac_shield(k),fac_shield(l)
6627 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6628 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6629 do ilist=1,ishield_list(i)
6630 iresshield=shield_list(ilist,i)
6632 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6634 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6636 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6637 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6641 do ilist=1,ishield_list(j)
6642 iresshield=shield_list(ilist,j)
6644 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6646 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6648 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6649 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6654 do ilist=1,ishield_list(k)
6655 iresshield=shield_list(ilist,k)
6657 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6659 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6661 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6662 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6666 do ilist=1,ishield_list(l)
6667 iresshield=shield_list(ilist,l)
6669 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6671 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6673 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6674 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6678 C print *,gshieldx(m,iresshield)
6680 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6681 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6682 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6683 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6684 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6685 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6686 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6687 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6689 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6690 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6691 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6692 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6693 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6694 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6695 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6696 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6704 C---------------------------------------------------------------------------
6705 subroutine dipole(i,j,jj)
6706 implicit real*8 (a-h,o-z)
6707 include 'DIMENSIONS'
6708 include 'COMMON.IOUNITS'
6709 include 'COMMON.CHAIN'
6710 include 'COMMON.FFIELD'
6711 include 'COMMON.DERIV'
6712 include 'COMMON.INTERACT'
6713 include 'COMMON.CONTACTS'
6714 include 'COMMON.CONTMAT'
6715 include 'COMMON.CORRMAT'
6716 include 'COMMON.TORSION'
6717 include 'COMMON.VAR'
6718 include 'COMMON.GEO'
6719 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6721 iti1 = itortyp(itype(i+1))
6722 if (j.lt.nres-1) then
6723 itj1 = itype2loc(itype(j+1))
6728 dipi(iii,1)=Ub2(iii,i)
6729 dipderi(iii)=Ub2der(iii,i)
6730 dipi(iii,2)=b1(iii,i+1)
6731 dipj(iii,1)=Ub2(iii,j)
6732 dipderj(iii)=Ub2der(iii,j)
6733 dipj(iii,2)=b1(iii,j+1)
6737 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6740 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6747 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6751 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6756 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6757 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6759 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6761 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6763 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6768 C---------------------------------------------------------------------------
6769 subroutine calc_eello(i,j,k,l,jj,kk)
6771 C This subroutine computes matrices and vectors needed to calculate
6772 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6774 implicit real*8 (a-h,o-z)
6775 include 'DIMENSIONS'
6776 include 'COMMON.IOUNITS'
6777 include 'COMMON.CHAIN'
6778 include 'COMMON.DERIV'
6779 include 'COMMON.INTERACT'
6780 include 'COMMON.CONTACTS'
6781 include 'COMMON.CONTMAT'
6782 include 'COMMON.CORRMAT'
6783 include 'COMMON.TORSION'
6784 include 'COMMON.VAR'
6785 include 'COMMON.GEO'
6786 include 'COMMON.FFIELD'
6787 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6788 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6791 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6792 cd & ' jj=',jj,' kk=',kk
6793 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6794 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6795 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6798 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6799 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6802 call transpose2(aa1(1,1),aa1t(1,1))
6803 call transpose2(aa2(1,1),aa2t(1,1))
6806 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6807 & aa1tder(1,1,lll,kkk))
6808 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6809 & aa2tder(1,1,lll,kkk))
6813 C parallel orientation of the two CA-CA-CA frames.
6815 iti=itype2loc(itype(i))
6819 itk1=itype2loc(itype(k+1))
6820 itj=itype2loc(itype(j))
6821 if (l.lt.nres-1) then
6822 itl1=itype2loc(itype(l+1))
6826 C A1 kernel(j+1) A2T
6828 cd write (iout,'(3f10.5,5x,3f10.5)')
6829 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6831 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6832 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6833 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6834 C Following matrices are needed only for 6-th order cumulants
6835 IF (wcorr6.gt.0.0d0) THEN
6836 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6837 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6838 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6839 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6840 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6841 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6842 & ADtEAderx(1,1,1,1,1,1))
6844 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6845 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6846 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6847 & ADtEA1derx(1,1,1,1,1,1))
6849 C End 6-th order cumulants
6852 cd write (2,*) 'In calc_eello6'
6854 cd write (2,*) 'iii=',iii
6856 cd write (2,*) 'kkk=',kkk
6858 cd write (2,'(3(2f10.5),5x)')
6859 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6864 call transpose2(EUgder(1,1,k),auxmat(1,1))
6865 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6866 call transpose2(EUg(1,1,k),auxmat(1,1))
6867 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6868 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6872 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6873 & EAEAderx(1,1,lll,kkk,iii,1))
6877 C A1T kernel(i+1) A2
6878 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6879 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6880 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6881 C Following matrices are needed only for 6-th order cumulants
6882 IF (wcorr6.gt.0.0d0) THEN
6883 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6884 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6885 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6886 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6887 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6888 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6889 & ADtEAderx(1,1,1,1,1,2))
6890 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6891 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6892 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6893 & ADtEA1derx(1,1,1,1,1,2))
6895 C End 6-th order cumulants
6896 call transpose2(EUgder(1,1,l),auxmat(1,1))
6897 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6898 call transpose2(EUg(1,1,l),auxmat(1,1))
6899 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6900 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6904 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6905 & EAEAderx(1,1,lll,kkk,iii,2))
6910 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6911 C They are needed only when the fifth- or the sixth-order cumulants are
6913 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6914 call transpose2(AEA(1,1,1),auxmat(1,1))
6915 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
6916 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6917 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6918 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6919 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
6920 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6921 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
6922 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
6923 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6924 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6925 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6926 call transpose2(AEA(1,1,2),auxmat(1,1))
6927 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
6928 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6929 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6930 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6931 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
6932 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6933 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
6934 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
6935 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6936 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6937 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6938 C Calculate the Cartesian derivatives of the vectors.
6942 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6943 call matvec2(auxmat(1,1),b1(1,i),
6944 & AEAb1derx(1,lll,kkk,iii,1,1))
6945 call matvec2(auxmat(1,1),Ub2(1,i),
6946 & AEAb2derx(1,lll,kkk,iii,1,1))
6947 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
6948 & AEAb1derx(1,lll,kkk,iii,2,1))
6949 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6950 & AEAb2derx(1,lll,kkk,iii,2,1))
6951 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6952 call matvec2(auxmat(1,1),b1(1,j),
6953 & AEAb1derx(1,lll,kkk,iii,1,2))
6954 call matvec2(auxmat(1,1),Ub2(1,j),
6955 & AEAb2derx(1,lll,kkk,iii,1,2))
6956 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
6957 & AEAb1derx(1,lll,kkk,iii,2,2))
6958 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6959 & AEAb2derx(1,lll,kkk,iii,2,2))
6966 C Antiparallel orientation of the two CA-CA-CA frames.
6968 iti=itype2loc(itype(i))
6972 itk1=itype2loc(itype(k+1))
6973 itl=itype2loc(itype(l))
6974 itj=itype2loc(itype(j))
6975 if (j.lt.nres-1) then
6976 itj1=itype2loc(itype(j+1))
6980 C A2 kernel(j-1)T A1T
6981 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6982 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6983 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6984 C Following matrices are needed only for 6-th order cumulants
6985 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6986 & j.eq.i+4 .and. l.eq.i+3)) THEN
6987 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6988 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6989 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6990 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6991 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6992 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6993 & ADtEAderx(1,1,1,1,1,1))
6994 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6995 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6996 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6997 & ADtEA1derx(1,1,1,1,1,1))
6999 C End 6-th order cumulants
7000 call transpose2(EUgder(1,1,k),auxmat(1,1))
7001 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7002 call transpose2(EUg(1,1,k),auxmat(1,1))
7003 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7004 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7008 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7009 & EAEAderx(1,1,lll,kkk,iii,1))
7013 C A2T kernel(i+1)T A1
7014 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7015 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7016 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7017 C Following matrices are needed only for 6-th order cumulants
7018 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7019 & j.eq.i+4 .and. l.eq.i+3)) THEN
7020 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7021 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7022 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7023 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7024 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7025 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7026 & ADtEAderx(1,1,1,1,1,2))
7027 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7028 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7029 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7030 & ADtEA1derx(1,1,1,1,1,2))
7032 C End 6-th order cumulants
7033 call transpose2(EUgder(1,1,j),auxmat(1,1))
7034 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7035 call transpose2(EUg(1,1,j),auxmat(1,1))
7036 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7037 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7041 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7042 & EAEAderx(1,1,lll,kkk,iii,2))
7047 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7048 C They are needed only when the fifth- or the sixth-order cumulants are
7050 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7051 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7052 call transpose2(AEA(1,1,1),auxmat(1,1))
7053 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7054 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7055 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7056 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7057 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7058 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7059 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7060 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7061 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7062 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7063 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7064 call transpose2(AEA(1,1,2),auxmat(1,1))
7065 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7066 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7067 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7068 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7069 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7070 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7071 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7072 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7073 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7074 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7075 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7076 C Calculate the Cartesian derivatives of the vectors.
7080 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7081 call matvec2(auxmat(1,1),b1(1,i),
7082 & AEAb1derx(1,lll,kkk,iii,1,1))
7083 call matvec2(auxmat(1,1),Ub2(1,i),
7084 & AEAb2derx(1,lll,kkk,iii,1,1))
7085 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7086 & AEAb1derx(1,lll,kkk,iii,2,1))
7087 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7088 & AEAb2derx(1,lll,kkk,iii,2,1))
7089 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7090 call matvec2(auxmat(1,1),b1(1,l),
7091 & AEAb1derx(1,lll,kkk,iii,1,2))
7092 call matvec2(auxmat(1,1),Ub2(1,l),
7093 & AEAb2derx(1,lll,kkk,iii,1,2))
7094 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7095 & AEAb1derx(1,lll,kkk,iii,2,2))
7096 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7097 & AEAb2derx(1,lll,kkk,iii,2,2))
7106 C---------------------------------------------------------------------------
7107 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7108 & KK,KKderg,AKA,AKAderg,AKAderx)
7112 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7113 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7114 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7119 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7121 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7124 cd if (lprn) write (2,*) 'In kernel'
7126 cd if (lprn) write (2,*) 'kkk=',kkk
7128 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7129 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7131 cd write (2,*) 'lll=',lll
7132 cd write (2,*) 'iii=1'
7134 cd write (2,'(3(2f10.5),5x)')
7135 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7138 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7139 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7141 cd write (2,*) 'lll=',lll
7142 cd write (2,*) 'iii=2'
7144 cd write (2,'(3(2f10.5),5x)')
7145 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7152 C---------------------------------------------------------------------------
7153 double precision function eello4(i,j,k,l,jj,kk)
7154 implicit real*8 (a-h,o-z)
7155 include 'DIMENSIONS'
7156 include 'COMMON.IOUNITS'
7157 include 'COMMON.CHAIN'
7158 include 'COMMON.DERIV'
7159 include 'COMMON.INTERACT'
7160 include 'COMMON.CONTACTS'
7161 include 'COMMON.CONTMAT'
7162 include 'COMMON.CORRMAT'
7163 include 'COMMON.TORSION'
7164 include 'COMMON.VAR'
7165 include 'COMMON.GEO'
7166 double precision pizda(2,2),ggg1(3),ggg2(3)
7167 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7171 cd print *,'eello4:',i,j,k,l,jj,kk
7172 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7173 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7174 cold eij=facont_hb(jj,i)
7175 cold ekl=facont_hb(kk,k)
7177 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7179 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7180 gcorr_loc(k-1)=gcorr_loc(k-1)
7181 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7183 gcorr_loc(l-1)=gcorr_loc(l-1)
7184 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7186 gcorr_loc(j-1)=gcorr_loc(j-1)
7187 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7192 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7193 & -EAEAderx(2,2,lll,kkk,iii,1)
7194 cd derx(lll,kkk,iii)=0.0d0
7198 cd gcorr_loc(l-1)=0.0d0
7199 cd gcorr_loc(j-1)=0.0d0
7200 cd gcorr_loc(k-1)=0.0d0
7202 cd write (iout,*)'Contacts have occurred for peptide groups',
7203 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7204 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7205 if (j.lt.nres-1) then
7212 if (l.lt.nres-1) then
7220 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7221 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7222 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7223 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7224 cgrad ghalf=0.5d0*ggg1(ll)
7225 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7226 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7227 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7228 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7229 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7230 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7231 cgrad ghalf=0.5d0*ggg2(ll)
7232 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7233 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7234 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7235 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7236 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7237 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7241 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7246 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7251 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7256 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7260 cd write (2,*) iii,gcorr_loc(iii)
7264 cd write (2,*) 'ekont',ekont
7265 cd write (iout,*) 'eello4',ekont*eel4
7268 C---------------------------------------------------------------------------
7269 double precision function eello5(i,j,k,l,jj,kk)
7270 implicit real*8 (a-h,o-z)
7271 include 'DIMENSIONS'
7272 include 'COMMON.IOUNITS'
7273 include 'COMMON.CHAIN'
7274 include 'COMMON.DERIV'
7275 include 'COMMON.INTERACT'
7276 include 'COMMON.CONTACTS'
7277 include 'COMMON.CONTMAT'
7278 include 'COMMON.CORRMAT'
7279 include 'COMMON.TORSION'
7280 include 'COMMON.VAR'
7281 include 'COMMON.GEO'
7282 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7283 double precision ggg1(3),ggg2(3)
7284 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7289 C /l\ / \ \ / \ / \ / C
7290 C / \ / \ \ / \ / \ / C
7291 C j| o |l1 | o | o| o | | o |o C
7292 C \ |/k\| |/ \| / |/ \| |/ \| C
7293 C \i/ \ / \ / / \ / \ C
7295 C (I) (II) (III) (IV) C
7297 C eello5_1 eello5_2 eello5_3 eello5_4 C
7299 C Antiparallel chains C
7302 C /j\ / \ \ / \ / \ / C
7303 C / \ / \ \ / \ / \ / C
7304 C j1| o |l | o | o| o | | o |o C
7305 C \ |/k\| |/ \| / |/ \| |/ \| C
7306 C \i/ \ / \ / / \ / \ C
7308 C (I) (II) (III) (IV) C
7310 C eello5_1 eello5_2 eello5_3 eello5_4 C
7312 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7314 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7315 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7320 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7322 itk=itype2loc(itype(k))
7323 itl=itype2loc(itype(l))
7324 itj=itype2loc(itype(j))
7329 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7330 cd & eel5_3_num,eel5_4_num)
7334 derx(lll,kkk,iii)=0.0d0
7338 cd eij=facont_hb(jj,i)
7339 cd ekl=facont_hb(kk,k)
7341 cd write (iout,*)'Contacts have occurred for peptide groups',
7342 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7344 C Contribution from the graph I.
7345 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7346 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7347 call transpose2(EUg(1,1,k),auxmat(1,1))
7348 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7349 vv(1)=pizda(1,1)-pizda(2,2)
7350 vv(2)=pizda(1,2)+pizda(2,1)
7351 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7352 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7354 C Explicit gradient in virtual-dihedral angles.
7355 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7356 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7357 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7358 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7359 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7360 vv(1)=pizda(1,1)-pizda(2,2)
7361 vv(2)=pizda(1,2)+pizda(2,1)
7362 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7363 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7364 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7365 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7366 vv(1)=pizda(1,1)-pizda(2,2)
7367 vv(2)=pizda(1,2)+pizda(2,1)
7369 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7370 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7371 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7373 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7374 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7375 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7377 C Cartesian gradient
7381 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7383 vv(1)=pizda(1,1)-pizda(2,2)
7384 vv(2)=pizda(1,2)+pizda(2,1)
7385 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7386 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7387 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7394 C Contribution from graph II
7395 call transpose2(EE(1,1,k),auxmat(1,1))
7396 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7397 vv(1)=pizda(1,1)+pizda(2,2)
7398 vv(2)=pizda(2,1)-pizda(1,2)
7399 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7400 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7402 C Explicit gradient in virtual-dihedral angles.
7403 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7404 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7405 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7406 vv(1)=pizda(1,1)+pizda(2,2)
7407 vv(2)=pizda(2,1)-pizda(1,2)
7409 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7410 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7411 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7413 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7414 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7415 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7417 C Cartesian gradient
7421 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7423 vv(1)=pizda(1,1)+pizda(2,2)
7424 vv(2)=pizda(2,1)-pizda(1,2)
7425 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7426 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7427 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7436 C Parallel orientation
7437 C Contribution from graph III
7438 call transpose2(EUg(1,1,l),auxmat(1,1))
7439 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7440 vv(1)=pizda(1,1)-pizda(2,2)
7441 vv(2)=pizda(1,2)+pizda(2,1)
7442 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7443 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7445 C Explicit gradient in virtual-dihedral angles.
7446 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7447 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7448 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7449 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7450 vv(1)=pizda(1,1)-pizda(2,2)
7451 vv(2)=pizda(1,2)+pizda(2,1)
7452 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7453 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7454 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7455 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7456 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7457 vv(1)=pizda(1,1)-pizda(2,2)
7458 vv(2)=pizda(1,2)+pizda(2,1)
7459 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7460 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7461 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7462 C Cartesian gradient
7466 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7468 vv(1)=pizda(1,1)-pizda(2,2)
7469 vv(2)=pizda(1,2)+pizda(2,1)
7470 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7471 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7472 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7477 C Contribution from graph IV
7479 call transpose2(EE(1,1,l),auxmat(1,1))
7480 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7481 vv(1)=pizda(1,1)+pizda(2,2)
7482 vv(2)=pizda(2,1)-pizda(1,2)
7483 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7484 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7485 C Explicit gradient in virtual-dihedral angles.
7486 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7487 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7488 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7489 vv(1)=pizda(1,1)+pizda(2,2)
7490 vv(2)=pizda(2,1)-pizda(1,2)
7491 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7492 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7493 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7494 C Cartesian gradient
7498 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7500 vv(1)=pizda(1,1)+pizda(2,2)
7501 vv(2)=pizda(2,1)-pizda(1,2)
7502 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7503 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7504 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7510 C Antiparallel orientation
7511 C Contribution from graph III
7513 call transpose2(EUg(1,1,j),auxmat(1,1))
7514 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7515 vv(1)=pizda(1,1)-pizda(2,2)
7516 vv(2)=pizda(1,2)+pizda(2,1)
7517 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7518 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7520 C Explicit gradient in virtual-dihedral angles.
7521 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7522 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7523 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7524 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7525 vv(1)=pizda(1,1)-pizda(2,2)
7526 vv(2)=pizda(1,2)+pizda(2,1)
7527 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7528 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7529 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7530 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7531 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7532 vv(1)=pizda(1,1)-pizda(2,2)
7533 vv(2)=pizda(1,2)+pizda(2,1)
7534 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7535 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7536 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7537 C Cartesian gradient
7541 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7543 vv(1)=pizda(1,1)-pizda(2,2)
7544 vv(2)=pizda(1,2)+pizda(2,1)
7545 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7546 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7547 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7553 C Contribution from graph IV
7555 call transpose2(EE(1,1,j),auxmat(1,1))
7556 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7557 vv(1)=pizda(1,1)+pizda(2,2)
7558 vv(2)=pizda(2,1)-pizda(1,2)
7559 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7560 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7562 C Explicit gradient in virtual-dihedral angles.
7563 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7564 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7565 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7566 vv(1)=pizda(1,1)+pizda(2,2)
7567 vv(2)=pizda(2,1)-pizda(1,2)
7568 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7569 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7570 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7571 C Cartesian gradient
7575 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7577 vv(1)=pizda(1,1)+pizda(2,2)
7578 vv(2)=pizda(2,1)-pizda(1,2)
7579 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7580 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7581 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7588 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7589 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7590 cd write (2,*) 'ijkl',i,j,k,l
7591 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7592 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7594 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7595 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7596 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7597 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7599 if (j.lt.nres-1) then
7606 if (l.lt.nres-1) then
7616 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7617 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7618 C summed up outside the subrouine as for the other subroutines
7619 C handling long-range interactions. The old code is commented out
7620 C with "cgrad" to keep track of changes.
7622 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7623 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7624 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7625 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7626 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7627 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7628 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7629 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7630 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7631 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7633 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7634 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7635 cgrad ghalf=0.5d0*ggg1(ll)
7637 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7638 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7639 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7640 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7641 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7642 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7643 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7644 cgrad ghalf=0.5d0*ggg2(ll)
7646 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7647 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7648 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7649 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7650 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7651 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7657 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7658 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7663 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7664 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7670 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7675 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7679 cd write (2,*) iii,g_corr5_loc(iii)
7682 cd write (2,*) 'ekont',ekont
7683 cd write (iout,*) 'eello5',ekont*eel5
7686 c--------------------------------------------------------------------------
7687 double precision function eello6(i,j,k,l,jj,kk)
7688 implicit real*8 (a-h,o-z)
7689 include 'DIMENSIONS'
7690 include 'COMMON.IOUNITS'
7691 include 'COMMON.CHAIN'
7692 include 'COMMON.DERIV'
7693 include 'COMMON.INTERACT'
7694 include 'COMMON.CONTACTS'
7695 include 'COMMON.CONTMAT'
7696 include 'COMMON.CORRMAT'
7697 include 'COMMON.TORSION'
7698 include 'COMMON.VAR'
7699 include 'COMMON.GEO'
7700 include 'COMMON.FFIELD'
7701 double precision ggg1(3),ggg2(3)
7702 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7707 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7715 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7716 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7720 derx(lll,kkk,iii)=0.0d0
7724 cd eij=facont_hb(jj,i)
7725 cd ekl=facont_hb(kk,k)
7731 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7732 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7733 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7734 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7735 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7736 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7738 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7739 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7740 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7741 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7742 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7743 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7747 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7749 C If turn contributions are considered, they will be handled separately.
7750 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7751 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7752 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7753 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7754 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7755 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7756 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7759 if (j.lt.nres-1) then
7766 if (l.lt.nres-1) then
7774 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7775 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7776 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7777 cgrad ghalf=0.5d0*ggg1(ll)
7779 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7780 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7781 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7782 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7783 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7784 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7785 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7786 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7787 cgrad ghalf=0.5d0*ggg2(ll)
7788 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7790 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7791 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7792 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7793 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7794 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7795 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7801 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7802 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7807 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7808 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7814 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7819 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7823 cd write (2,*) iii,g_corr6_loc(iii)
7826 cd write (2,*) 'ekont',ekont
7827 cd write (iout,*) 'eello6',ekont*eel6
7830 c--------------------------------------------------------------------------
7831 double precision function eello6_graph1(i,j,k,l,imat,swap)
7832 implicit real*8 (a-h,o-z)
7833 include 'DIMENSIONS'
7834 include 'COMMON.IOUNITS'
7835 include 'COMMON.CHAIN'
7836 include 'COMMON.DERIV'
7837 include 'COMMON.INTERACT'
7838 include 'COMMON.CONTACTS'
7839 include 'COMMON.CONTMAT'
7840 include 'COMMON.CORRMAT'
7841 include 'COMMON.TORSION'
7842 include 'COMMON.VAR'
7843 include 'COMMON.GEO'
7844 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7848 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7850 C Parallel Antiparallel C
7856 C \ j|/k\| / \ |/k\|l / C
7861 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7862 itk=itype2loc(itype(k))
7863 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7864 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7865 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7866 call transpose2(EUgC(1,1,k),auxmat(1,1))
7867 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7868 vv1(1)=pizda1(1,1)-pizda1(2,2)
7869 vv1(2)=pizda1(1,2)+pizda1(2,1)
7870 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7871 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
7872 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
7873 s5=scalar2(vv(1),Dtobr2(1,i))
7874 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7875 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7877 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7878 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7879 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7880 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7881 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7882 & +scalar2(vv(1),Dtobr2der(1,i)))
7883 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7884 vv1(1)=pizda1(1,1)-pizda1(2,2)
7885 vv1(2)=pizda1(1,2)+pizda1(2,1)
7886 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
7887 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
7889 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7890 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7891 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7892 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7893 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7895 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7896 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7897 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7898 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7899 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7901 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7902 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7903 vv1(1)=pizda1(1,1)-pizda1(2,2)
7904 vv1(2)=pizda1(1,2)+pizda1(2,1)
7905 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7906 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7907 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7908 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7917 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7918 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7919 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7920 call transpose2(EUgC(1,1,k),auxmat(1,1))
7921 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7923 vv1(1)=pizda1(1,1)-pizda1(2,2)
7924 vv1(2)=pizda1(1,2)+pizda1(2,1)
7925 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7926 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
7927 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
7928 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
7929 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
7930 s5=scalar2(vv(1),Dtobr2(1,i))
7931 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7938 c----------------------------------------------------------------------------
7939 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7940 implicit real*8 (a-h,o-z)
7941 include 'DIMENSIONS'
7942 include 'COMMON.IOUNITS'
7943 include 'COMMON.CHAIN'
7944 include 'COMMON.DERIV'
7945 include 'COMMON.INTERACT'
7946 include 'COMMON.CONTACTS'
7947 include 'COMMON.CONTMAT'
7948 include 'COMMON.CORRMAT'
7949 include 'COMMON.TORSION'
7950 include 'COMMON.VAR'
7951 include 'COMMON.GEO'
7953 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7954 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7957 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7959 C Parallel Antiparallel C
7965 C \ j|/k\| \ |/k\|l C
7970 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7971 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7972 C AL 7/4/01 s1 would occur in the sixth-order moment,
7973 C but not in a cluster cumulant
7975 s1=dip(1,jj,i)*dip(1,kk,k)
7977 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7978 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7979 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7980 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7981 call transpose2(EUg(1,1,k),auxmat(1,1))
7982 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7983 vv(1)=pizda(1,1)-pizda(2,2)
7984 vv(2)=pizda(1,2)+pizda(2,1)
7985 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7986 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7988 eello6_graph2=-(s1+s2+s3+s4)
7990 eello6_graph2=-(s2+s3+s4)
7993 C Derivatives in gamma(i-1)
7997 s1=dipderg(1,jj,i)*dip(1,kk,k)
7999 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8000 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8001 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8002 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8004 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8006 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8008 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8010 C Derivatives in gamma(k-1)
8012 s1=dip(1,jj,i)*dipderg(1,kk,k)
8014 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8015 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8016 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8017 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8018 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8019 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8020 vv(1)=pizda(1,1)-pizda(2,2)
8021 vv(2)=pizda(1,2)+pizda(2,1)
8022 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8024 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8026 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8028 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8029 C Derivatives in gamma(j-1) or gamma(l-1)
8032 s1=dipderg(3,jj,i)*dip(1,kk,k)
8034 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8035 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8036 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8037 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8038 vv(1)=pizda(1,1)-pizda(2,2)
8039 vv(2)=pizda(1,2)+pizda(2,1)
8040 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8043 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8045 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8048 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8049 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8051 C Derivatives in gamma(l-1) or gamma(j-1)
8054 s1=dip(1,jj,i)*dipderg(3,kk,k)
8056 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8057 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8058 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8059 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8060 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8061 vv(1)=pizda(1,1)-pizda(2,2)
8062 vv(2)=pizda(1,2)+pizda(2,1)
8063 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8066 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8068 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8071 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8072 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8074 C Cartesian derivatives.
8076 write (2,*) 'In eello6_graph2'
8078 write (2,*) 'iii=',iii
8080 write (2,*) 'kkk=',kkk
8082 write (2,'(3(2f10.5),5x)')
8083 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8093 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8095 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8098 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8100 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8101 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8103 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8104 call transpose2(EUg(1,1,k),auxmat(1,1))
8105 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8107 vv(1)=pizda(1,1)-pizda(2,2)
8108 vv(2)=pizda(1,2)+pizda(2,1)
8109 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8110 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8112 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8114 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8117 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8119 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8127 c----------------------------------------------------------------------------
8128 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8129 implicit real*8 (a-h,o-z)
8130 include 'DIMENSIONS'
8131 include 'COMMON.IOUNITS'
8132 include 'COMMON.CHAIN'
8133 include 'COMMON.DERIV'
8134 include 'COMMON.INTERACT'
8135 include 'COMMON.CONTACTS'
8136 include 'COMMON.CONTMAT'
8137 include 'COMMON.CORRMAT'
8138 include 'COMMON.TORSION'
8139 include 'COMMON.VAR'
8140 include 'COMMON.GEO'
8141 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8143 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8145 C Parallel Antiparallel C
8151 C j|/k\| / |/k\|l / C
8156 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8158 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8159 C energy moment and not to the cluster cumulant.
8160 iti=itortyp(itype(i))
8161 if (j.lt.nres-1) then
8162 itj1=itype2loc(itype(j+1))
8166 itk=itype2loc(itype(k))
8167 itk1=itype2loc(itype(k+1))
8168 if (l.lt.nres-1) then
8169 itl1=itype2loc(itype(l+1))
8174 s1=dip(4,jj,i)*dip(4,kk,k)
8176 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8177 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8178 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8179 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8180 call transpose2(EE(1,1,k),auxmat(1,1))
8181 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8182 vv(1)=pizda(1,1)+pizda(2,2)
8183 vv(2)=pizda(2,1)-pizda(1,2)
8184 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8185 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8186 cd & "sum",-(s2+s3+s4)
8188 eello6_graph3=-(s1+s2+s3+s4)
8190 eello6_graph3=-(s2+s3+s4)
8193 C Derivatives in gamma(k-1)
8195 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8196 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8197 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8198 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8199 C Derivatives in gamma(l-1)
8200 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8201 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8202 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8203 vv(1)=pizda(1,1)+pizda(2,2)
8204 vv(2)=pizda(2,1)-pizda(1,2)
8205 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8206 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8207 C Cartesian derivatives.
8213 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8215 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8218 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8220 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8221 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8223 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8224 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8226 vv(1)=pizda(1,1)+pizda(2,2)
8227 vv(2)=pizda(2,1)-pizda(1,2)
8228 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8230 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8232 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8235 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8237 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8239 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8246 c----------------------------------------------------------------------------
8247 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8248 implicit real*8 (a-h,o-z)
8249 include 'DIMENSIONS'
8250 include 'COMMON.IOUNITS'
8251 include 'COMMON.CHAIN'
8252 include 'COMMON.DERIV'
8253 include 'COMMON.INTERACT'
8254 include 'COMMON.CONTACTS'
8255 include 'COMMON.CONTMAT'
8256 include 'COMMON.CORRMAT'
8257 include 'COMMON.TORSION'
8258 include 'COMMON.VAR'
8259 include 'COMMON.GEO'
8260 include 'COMMON.FFIELD'
8261 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8262 & auxvec1(2),auxmat1(2,2)
8264 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8266 C Parallel Antiparallel C
8272 C \ j|/k\| \ |/k\|l C
8277 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8279 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8280 C energy moment and not to the cluster cumulant.
8281 cd write (2,*) 'eello_graph4: wturn6',wturn6
8282 iti=itype2loc(itype(i))
8283 itj=itype2loc(itype(j))
8284 if (j.lt.nres-1) then
8285 itj1=itype2loc(itype(j+1))
8289 itk=itype2loc(itype(k))
8290 if (k.lt.nres-1) then
8291 itk1=itype2loc(itype(k+1))
8295 itl=itype2loc(itype(l))
8296 if (l.lt.nres-1) then
8297 itl1=itype2loc(itype(l+1))
8301 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8302 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8303 cd & ' itl',itl,' itl1',itl1
8306 s1=dip(3,jj,i)*dip(3,kk,k)
8308 s1=dip(2,jj,j)*dip(2,kk,l)
8311 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8312 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8314 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8315 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8317 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8318 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8320 call transpose2(EUg(1,1,k),auxmat(1,1))
8321 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8322 vv(1)=pizda(1,1)-pizda(2,2)
8323 vv(2)=pizda(2,1)+pizda(1,2)
8324 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8325 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8327 eello6_graph4=-(s1+s2+s3+s4)
8329 eello6_graph4=-(s2+s3+s4)
8331 C Derivatives in gamma(i-1)
8336 s1=dipderg(2,jj,i)*dip(3,kk,k)
8338 s1=dipderg(4,jj,j)*dip(2,kk,l)
8341 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8343 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8344 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8346 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8347 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8349 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8350 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8351 cd write (2,*) 'turn6 derivatives'
8353 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8355 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8359 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8361 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8365 C Derivatives in gamma(k-1)
8368 s1=dip(3,jj,i)*dipderg(2,kk,k)
8370 s1=dip(2,jj,j)*dipderg(4,kk,l)
8373 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8374 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8376 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8377 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8379 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8380 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8382 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8383 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8384 vv(1)=pizda(1,1)-pizda(2,2)
8385 vv(2)=pizda(2,1)+pizda(1,2)
8386 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8387 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8389 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8391 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8395 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8397 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8400 C Derivatives in gamma(j-1) or gamma(l-1)
8401 if (l.eq.j+1 .and. l.gt.1) then
8402 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8403 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8404 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8405 vv(1)=pizda(1,1)-pizda(2,2)
8406 vv(2)=pizda(2,1)+pizda(1,2)
8407 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8408 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8409 else if (j.gt.1) then
8410 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8411 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8412 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8413 vv(1)=pizda(1,1)-pizda(2,2)
8414 vv(2)=pizda(2,1)+pizda(1,2)
8415 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8416 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8417 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8419 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8422 C Cartesian derivatives.
8429 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8431 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8435 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8437 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8441 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8443 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8445 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8446 & b1(1,j+1),auxvec(1))
8447 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8449 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8450 & b1(1,l+1),auxvec(1))
8451 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8453 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8455 vv(1)=pizda(1,1)-pizda(2,2)
8456 vv(2)=pizda(2,1)+pizda(1,2)
8457 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8459 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8461 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8464 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8467 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8470 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8472 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8474 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8478 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8480 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8483 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8485 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8494 c----------------------------------------------------------------------------
8495 double precision function eello_turn6(i,jj,kk)
8496 implicit real*8 (a-h,o-z)
8497 include 'DIMENSIONS'
8498 include 'COMMON.IOUNITS'
8499 include 'COMMON.CHAIN'
8500 include 'COMMON.DERIV'
8501 include 'COMMON.INTERACT'
8502 include 'COMMON.CONTACTS'
8503 include 'COMMON.CONTMAT'
8504 include 'COMMON.CORRMAT'
8505 include 'COMMON.TORSION'
8506 include 'COMMON.VAR'
8507 include 'COMMON.GEO'
8508 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8509 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8511 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8512 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8513 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8514 C the respective energy moment and not to the cluster cumulant.
8523 iti=itype2loc(itype(i))
8524 itk=itype2loc(itype(k))
8525 itk1=itype2loc(itype(k+1))
8526 itl=itype2loc(itype(l))
8527 itj=itype2loc(itype(j))
8528 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8529 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8530 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8535 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8537 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8541 derx_turn(lll,kkk,iii)=0.0d0
8548 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8550 cd write (2,*) 'eello6_5',eello6_5
8552 call transpose2(AEA(1,1,1),auxmat(1,1))
8553 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8554 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8555 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8557 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8558 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8559 s2 = scalar2(b1(1,k),vtemp1(1))
8561 call transpose2(AEA(1,1,2),atemp(1,1))
8562 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8563 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8564 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8566 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8567 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8568 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8570 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8571 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8572 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8573 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8574 ss13 = scalar2(b1(1,k),vtemp4(1))
8575 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8577 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8583 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8584 C Derivatives in gamma(i+2)
8589 call transpose2(AEA(1,1,1),auxmatd(1,1))
8590 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8591 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8592 call transpose2(AEAderg(1,1,2),atempd(1,1))
8593 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8594 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8596 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8597 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8598 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8604 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8605 C Derivatives in gamma(i+3)
8607 call transpose2(AEA(1,1,1),auxmatd(1,1))
8608 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8609 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8610 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8612 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8613 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8614 s2d = scalar2(b1(1,k),vtemp1d(1))
8616 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8617 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8619 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8621 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8622 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8623 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8631 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8632 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8634 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8635 & -0.5d0*ekont*(s2d+s12d)
8637 C Derivatives in gamma(i+4)
8638 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8639 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8640 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8642 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8643 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8644 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8652 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8654 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8656 C Derivatives in gamma(i+5)
8658 call transpose2(AEAderg(1,1,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),vtemp1d(1))
8663 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8664 s2d = scalar2(b1(1,k),vtemp1d(1))
8666 call transpose2(AEA(1,1,2),atempd(1,1))
8667 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8668 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8670 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8671 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8673 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8674 ss13d = scalar2(b1(1,k),vtemp4d(1))
8675 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8683 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8684 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8686 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8687 & -0.5d0*ekont*(s2d+s12d)
8689 C Cartesian derivatives
8694 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8695 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8696 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8698 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8699 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8701 s2d = scalar2(b1(1,k),vtemp1d(1))
8703 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8704 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8705 s8d = -(atempd(1,1)+atempd(2,2))*
8706 & scalar2(cc(1,1,l),vtemp2(1))
8708 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8710 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8711 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8718 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8721 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8725 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8726 & - 0.5d0*(s8d+s12d)
8728 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8737 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8739 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8740 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8741 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8742 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8743 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8745 ss13d = scalar2(b1(1,k),vtemp4d(1))
8746 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8747 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8751 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8752 cd & 16*eel_turn6_num
8754 if (j.lt.nres-1) then
8761 if (l.lt.nres-1) then
8769 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8770 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8771 cgrad ghalf=0.5d0*ggg1(ll)
8773 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8774 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8775 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8776 & +ekont*derx_turn(ll,2,1)
8777 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8778 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8779 & +ekont*derx_turn(ll,4,1)
8780 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8781 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8782 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8783 cgrad ghalf=0.5d0*ggg2(ll)
8785 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8786 & +ekont*derx_turn(ll,2,2)
8787 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8788 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8789 & +ekont*derx_turn(ll,4,2)
8790 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8791 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8792 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8797 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8802 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8808 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8813 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8817 cd write (2,*) iii,g_corr6_loc(iii)
8820 eello_turn6=ekont*eel_turn6
8821 cd write (2,*) 'ekont',ekont
8822 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8826 crc-------------------------------------------------
8827 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8828 subroutine Eliptransfer(eliptran)
8829 implicit real*8 (a-h,o-z)
8830 include 'DIMENSIONS'
8831 include 'COMMON.GEO'
8832 include 'COMMON.VAR'
8833 include 'COMMON.LOCAL'
8834 include 'COMMON.CHAIN'
8835 include 'COMMON.DERIV'
8836 include 'COMMON.INTERACT'
8837 include 'COMMON.IOUNITS'
8838 include 'COMMON.CALC'
8839 include 'COMMON.CONTROL'
8840 include 'COMMON.SPLITELE'
8841 include 'COMMON.SBRIDGE'
8842 C this is done by Adasko
8846 C--bordliptop-- buffore starts
8847 C--bufliptop--- here true lipid starts
8849 C--buflipbot--- lipid ends buffore starts
8850 C--bordlipbot--buffore ends
8854 if (itype(i).eq.ntyp1) cycle
8856 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8857 if (positi.le.0) positi=positi+boxzsize
8859 C first for peptide groups
8860 c for each residue check if it is in lipid or lipid water border area
8861 if ((positi.gt.bordlipbot)
8862 &.and.(positi.lt.bordliptop)) then
8863 C the energy transfer exist
8864 if (positi.lt.buflipbot) then
8865 C what fraction I am in
8867 & ((positi-bordlipbot)/lipbufthick)
8868 C lipbufthick is thickenes of lipid buffore
8869 sslip=sscalelip(fracinbuf)
8870 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8871 eliptran=eliptran+sslip*pepliptran
8872 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8873 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8874 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8875 elseif (positi.gt.bufliptop) then
8876 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8877 sslip=sscalelip(fracinbuf)
8878 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8879 eliptran=eliptran+sslip*pepliptran
8880 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8881 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8882 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8883 C print *, "doing sscalefor top part"
8884 C print *,i,sslip,fracinbuf,ssgradlip
8886 eliptran=eliptran+pepliptran
8887 C print *,"I am in true lipid"
8890 C eliptran=elpitran+0.0 ! I am in water
8893 C print *, "nic nie bylo w lipidzie?"
8894 C now multiply all by the peptide group transfer factor
8895 C eliptran=eliptran*pepliptran
8896 C now the same for side chains
8899 if (itype(i).eq.ntyp1) cycle
8900 positi=(mod(c(3,i+nres),boxzsize))
8901 if (positi.le.0) positi=positi+boxzsize
8902 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8903 c for each residue check if it is in lipid or lipid water border area
8904 C respos=mod(c(3,i+nres),boxzsize)
8905 C print *,positi,bordlipbot,buflipbot
8906 if ((positi.gt.bordlipbot)
8907 & .and.(positi.lt.bordliptop)) then
8908 C the energy transfer exist
8909 if (positi.lt.buflipbot) then
8911 & ((positi-bordlipbot)/lipbufthick)
8912 C lipbufthick is thickenes of lipid buffore
8913 sslip=sscalelip(fracinbuf)
8914 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8915 eliptran=eliptran+sslip*liptranene(itype(i))
8916 gliptranx(3,i)=gliptranx(3,i)
8917 &+ssgradlip*liptranene(itype(i))
8918 gliptranc(3,i-1)= gliptranc(3,i-1)
8919 &+ssgradlip*liptranene(itype(i))
8920 C print *,"doing sccale for lower part"
8921 elseif (positi.gt.bufliptop) then
8923 &((bordliptop-positi)/lipbufthick)
8924 sslip=sscalelip(fracinbuf)
8925 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8926 eliptran=eliptran+sslip*liptranene(itype(i))
8927 gliptranx(3,i)=gliptranx(3,i)
8928 &+ssgradlip*liptranene(itype(i))
8929 gliptranc(3,i-1)= gliptranc(3,i-1)
8930 &+ssgradlip*liptranene(itype(i))
8931 C print *, "doing sscalefor top part",sslip,fracinbuf
8933 eliptran=eliptran+liptranene(itype(i))
8934 C print *,"I am in true lipid"
8936 endif ! if in lipid or buffor
8938 C eliptran=elpitran+0.0 ! I am in water
8944 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8946 SUBROUTINE MATVEC2(A1,V1,V2)
8947 implicit real*8 (a-h,o-z)
8948 include 'DIMENSIONS'
8949 DIMENSION A1(2,2),V1(2),V2(2)
8953 c 3 VI=VI+A1(I,K)*V1(K)
8957 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8958 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8963 C---------------------------------------
8964 SUBROUTINE MATMAT2(A1,A2,A3)
8965 implicit real*8 (a-h,o-z)
8966 include 'DIMENSIONS'
8967 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8968 c DIMENSION AI3(2,2)
8972 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8978 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8979 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8980 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8981 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8989 c-------------------------------------------------------------------------
8990 double precision function scalar2(u,v)
8992 double precision u(2),v(2)
8995 scalar2=u(1)*v(1)+u(2)*v(2)
8999 C-----------------------------------------------------------------------------
9001 subroutine transpose2(a,at)
9003 double precision a(2,2),at(2,2)
9010 c--------------------------------------------------------------------------
9011 subroutine transpose(n,a,at)
9014 double precision a(n,n),at(n,n)
9022 C---------------------------------------------------------------------------
9023 subroutine prodmat3(a1,a2,kk,transp,prod)
9026 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9028 crc double precision auxmat(2,2),prod_(2,2)
9031 crc call transpose2(kk(1,1),auxmat(1,1))
9032 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9033 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9035 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9036 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9037 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9038 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9039 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9040 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9041 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9042 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9045 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9046 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9048 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9049 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9050 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9051 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9052 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9053 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9054 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9055 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9058 c call transpose2(a2(1,1),a2t(1,1))
9061 crc print *,((prod_(i,j),i=1,2),j=1,2)
9062 crc print *,((prod(i,j),i=1,2),j=1,2)
9066 C-----------------------------------------------------------------------------
9067 double precision function scalar(u,v)
9069 double precision u(3),v(3)
9079 C-----------------------------------------------------------------------
9080 double precision function sscale(r)
9081 double precision r,gamm
9082 include "COMMON.SPLITELE"
9083 if(r.lt.r_cut-rlamb) then
9085 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9086 gamm=(r-(r_cut-rlamb))/rlamb
9087 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9093 C-----------------------------------------------------------------------
9094 C-----------------------------------------------------------------------
9095 double precision function sscagrad(r)
9096 double precision r,gamm
9097 include "COMMON.SPLITELE"
9098 if(r.lt.r_cut-rlamb) then
9100 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9101 gamm=(r-(r_cut-rlamb))/rlamb
9102 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9108 C-----------------------------------------------------------------------
9109 C-----------------------------------------------------------------------
9110 double precision function sscalelip(r)
9111 double precision r,gamm
9112 include "COMMON.SPLITELE"
9113 C if(r.lt.r_cut-rlamb) then
9115 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9116 C gamm=(r-(r_cut-rlamb))/rlamb
9117 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9123 C-----------------------------------------------------------------------
9124 double precision function sscagradlip(r)
9125 double precision r,gamm
9126 include "COMMON.SPLITELE"
9127 C if(r.lt.r_cut-rlamb) then
9129 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9130 C gamm=(r-(r_cut-rlamb))/rlamb
9131 sscagradlip=r*(6*r-6.0d0)
9138 C-----------------------------------------------------------------------
9139 subroutine set_shield_fac
9140 implicit real*8 (a-h,o-z)
9141 include 'DIMENSIONS'
9142 include 'COMMON.CHAIN'
9143 include 'COMMON.DERIV'
9144 include 'COMMON.IOUNITS'
9145 include 'COMMON.SHIELD'
9146 include 'COMMON.INTERACT'
9147 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9148 double precision div77_81/0.974996043d0/,
9149 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9151 C the vector between center of side_chain and peptide group
9152 double precision pep_side(3),long,side_calf(3),
9153 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9154 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9155 C the line belowe needs to be changed for FGPROC>1
9157 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9159 Cif there two consequtive dummy atoms there is no peptide group between them
9160 C the line below has to be changed for FGPROC>1
9163 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9167 C first lets set vector conecting the ithe side-chain with kth side-chain
9168 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9170 C and vector conecting the side-chain with its proper calfa
9171 side_calf(j)=c(j,k+nres)-c(j,k)
9172 C side_calf(j)=2.0d0
9173 pept_group(j)=c(j,i)-c(j,i+1)
9174 C lets have their lenght
9175 dist_pep_side=pep_side(j)**2+dist_pep_side
9176 dist_side_calf=dist_side_calf+side_calf(j)**2
9177 dist_pept_group=dist_pept_group+pept_group(j)**2
9179 dist_pep_side=dsqrt(dist_pep_side)
9180 dist_pept_group=dsqrt(dist_pept_group)
9181 dist_side_calf=dsqrt(dist_side_calf)
9183 pep_side_norm(j)=pep_side(j)/dist_pep_side
9184 side_calf_norm(j)=dist_side_calf
9186 C now sscale fraction
9187 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9188 C print *,buff_shield,"buff"
9190 if (sh_frac_dist.le.0.0) cycle
9191 C If we reach here it means that this side chain reaches the shielding sphere
9192 C Lets add him to the list for gradient
9193 ishield_list(i)=ishield_list(i)+1
9194 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9195 C this list is essential otherwise problem would be O3
9196 shield_list(ishield_list(i),i)=k
9197 C Lets have the sscale value
9198 if (sh_frac_dist.gt.1.0) then
9199 scale_fac_dist=1.0d0
9201 sh_frac_dist_grad(j)=0.0d0
9204 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9205 & *(2.0*sh_frac_dist-3.0d0)
9206 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9207 & /dist_pep_side/buff_shield*0.5
9208 C remember for the final gradient multiply sh_frac_dist_grad(j)
9209 C for side_chain by factor -2 !
9211 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9212 C print *,"jestem",scale_fac_dist,fac_help_scale,
9213 C & sh_frac_dist_grad(j)
9216 C if ((i.eq.3).and.(k.eq.2)) then
9217 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9221 C this is what is now we have the distance scaling now volume...
9222 short=short_r_sidechain(itype(k))
9223 long=long_r_sidechain(itype(k))
9224 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9227 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9230 costhet_grad(j)=costhet_fac*pep_side(j)
9232 C remember for the final gradient multiply costhet_grad(j)
9233 C for side_chain by factor -2 !
9234 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9235 C pep_side0pept_group is vector multiplication
9236 pep_side0pept_group=0.0
9238 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9240 cosalfa=(pep_side0pept_group/
9241 & (dist_pep_side*dist_side_calf))
9242 fac_alfa_sin=1.0-cosalfa**2
9243 fac_alfa_sin=dsqrt(fac_alfa_sin)
9244 rkprim=fac_alfa_sin*(long-short)+short
9246 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9247 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9250 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9251 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9252 &*(long-short)/fac_alfa_sin*cosalfa/
9253 &((dist_pep_side*dist_side_calf))*
9254 &((side_calf(j))-cosalfa*
9255 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9257 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9258 &*(long-short)/fac_alfa_sin*cosalfa
9259 &/((dist_pep_side*dist_side_calf))*
9261 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9264 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9267 C now the gradient...
9268 C grad_shield is gradient of Calfa for peptide groups
9269 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9271 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9272 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9274 grad_shield(j,i)=grad_shield(j,i)
9275 C gradient po skalowaniu
9276 & +(sh_frac_dist_grad(j)
9277 C gradient po costhet
9278 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9279 &-scale_fac_dist*(cosphi_grad_long(j))
9280 &/(1.0-cosphi) )*div77_81
9282 C grad_shield_side is Cbeta sidechain gradient
9283 grad_shield_side(j,ishield_list(i),i)=
9284 & (sh_frac_dist_grad(j)*(-2.0d0)
9285 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9286 & +scale_fac_dist*(cosphi_grad_long(j))
9287 & *2.0d0/(1.0-cosphi))
9288 & *div77_81*VofOverlap
9290 grad_shield_loc(j,ishield_list(i),i)=
9291 & scale_fac_dist*cosphi_grad_loc(j)
9292 & *2.0d0/(1.0-cosphi)
9293 & *div77_81*VofOverlap
9295 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9297 fac_shield(i)=VolumeTotal*div77_81+div4_81
9298 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9302 C--------------------------------------------------------------------------
9303 C first for shielding is setting of function of side-chains
9304 subroutine set_shield_fac2
9305 implicit real*8 (a-h,o-z)
9306 include 'DIMENSIONS'
9307 include 'COMMON.CHAIN'
9308 include 'COMMON.DERIV'
9309 include 'COMMON.IOUNITS'
9310 include 'COMMON.SHIELD'
9311 include 'COMMON.INTERACT'
9312 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9313 double precision div77_81/0.974996043d0/,
9314 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9316 C the vector between center of side_chain and peptide group
9317 double precision pep_side(3),long,side_calf(3),
9318 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9319 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9320 C the line belowe needs to be changed for FGPROC>1
9322 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9324 Cif there two consequtive dummy atoms there is no peptide group between them
9325 C the line below has to be changed for FGPROC>1
9328 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9332 C first lets set vector conecting the ithe side-chain with kth side-chain
9333 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9335 C and vector conecting the side-chain with its proper calfa
9336 side_calf(j)=c(j,k+nres)-c(j,k)
9337 C side_calf(j)=2.0d0
9338 pept_group(j)=c(j,i)-c(j,i+1)
9339 C lets have their lenght
9340 dist_pep_side=pep_side(j)**2+dist_pep_side
9341 dist_side_calf=dist_side_calf+side_calf(j)**2
9342 dist_pept_group=dist_pept_group+pept_group(j)**2
9344 dist_pep_side=dsqrt(dist_pep_side)
9345 dist_pept_group=dsqrt(dist_pept_group)
9346 dist_side_calf=dsqrt(dist_side_calf)
9348 pep_side_norm(j)=pep_side(j)/dist_pep_side
9349 side_calf_norm(j)=dist_side_calf
9351 C now sscale fraction
9352 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9353 C print *,buff_shield,"buff"
9355 if (sh_frac_dist.le.0.0) cycle
9356 C If we reach here it means that this side chain reaches the shielding sphere
9357 C Lets add him to the list for gradient
9358 ishield_list(i)=ishield_list(i)+1
9359 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9360 C this list is essential otherwise problem would be O3
9361 shield_list(ishield_list(i),i)=k
9362 C Lets have the sscale value
9363 if (sh_frac_dist.gt.1.0) then
9364 scale_fac_dist=1.0d0
9366 sh_frac_dist_grad(j)=0.0d0
9369 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9370 & *(2.0d0*sh_frac_dist-3.0d0)
9371 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9372 & /dist_pep_side/buff_shield*0.5d0
9373 C remember for the final gradient multiply sh_frac_dist_grad(j)
9374 C for side_chain by factor -2 !
9376 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9377 C sh_frac_dist_grad(j)=0.0d0
9378 C scale_fac_dist=1.0d0
9379 C print *,"jestem",scale_fac_dist,fac_help_scale,
9380 C & sh_frac_dist_grad(j)
9383 C this is what is now we have the distance scaling now volume...
9384 short=short_r_sidechain(itype(k))
9385 long=long_r_sidechain(itype(k))
9386 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9387 sinthet=short/dist_pep_side*costhet
9391 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9392 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9393 C & -short/dist_pep_side**2/costhet)
9396 costhet_grad(j)=costhet_fac*pep_side(j)
9398 C remember for the final gradient multiply costhet_grad(j)
9399 C for side_chain by factor -2 !
9400 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9401 C pep_side0pept_group is vector multiplication
9402 pep_side0pept_group=0.0d0
9404 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9406 cosalfa=(pep_side0pept_group/
9407 & (dist_pep_side*dist_side_calf))
9408 fac_alfa_sin=1.0d0-cosalfa**2
9409 fac_alfa_sin=dsqrt(fac_alfa_sin)
9410 rkprim=fac_alfa_sin*(long-short)+short
9414 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9416 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9417 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9421 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9422 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9423 &*(long-short)/fac_alfa_sin*cosalfa/
9424 &((dist_pep_side*dist_side_calf))*
9425 &((side_calf(j))-cosalfa*
9426 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9427 C cosphi_grad_long(j)=0.0d0
9428 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9429 &*(long-short)/fac_alfa_sin*cosalfa
9430 &/((dist_pep_side*dist_side_calf))*
9432 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9433 C cosphi_grad_loc(j)=0.0d0
9435 C print *,sinphi,sinthet
9436 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9439 C now the gradient...
9441 grad_shield(j,i)=grad_shield(j,i)
9442 C gradient po skalowaniu
9443 & +(sh_frac_dist_grad(j)*VofOverlap
9444 C gradient po costhet
9445 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9446 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9447 & sinphi/sinthet*costhet*costhet_grad(j)
9448 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9450 C grad_shield_side is Cbeta sidechain gradient
9451 grad_shield_side(j,ishield_list(i),i)=
9452 & (sh_frac_dist_grad(j)*(-2.0d0)
9454 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9455 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9456 & sinphi/sinthet*costhet*costhet_grad(j)
9457 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9460 grad_shield_loc(j,ishield_list(i),i)=
9461 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9462 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9463 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9467 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9469 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9470 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9471 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9475 C--------------------------------------------------------------------------
9476 double precision function tschebyshev(m,n,x,y)
9478 include "DIMENSIONS"
9480 double precision x(n),y,yy(0:maxvar),aux
9481 c Tschebyshev polynomial. Note that the first term is omitted
9482 c m=0: the constant term is included
9483 c m=1: the constant term is not included
9487 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9496 C--------------------------------------------------------------------------
9497 double precision function gradtschebyshev(m,n,x,y)
9499 include "DIMENSIONS"
9501 double precision x(n+1),y,yy(0:maxvar),aux
9502 c Tschebyshev polynomial. Note that the first term is omitted
9503 c m=0: the constant term is included
9504 c m=1: the constant term is not included
9508 yy(i)=2*y*yy(i-1)-yy(i-2)
9512 aux=aux+x(i+1)*yy(i)*(i+1)
9513 C print *, x(i+1),yy(i),i
9518 c----------------------------------------------------------------------------
9519 double precision function sscale2(r,r_cut,r0,rlamb)
9521 double precision r,gamm,r_cut,r0,rlamb,rr
9523 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9524 c write (2,*) "rr",rr
9525 if(rr.lt.r_cut-rlamb) then
9527 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9528 gamm=(rr-(r_cut-rlamb))/rlamb
9529 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9535 C-----------------------------------------------------------------------
9536 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9538 double precision r,gamm,r_cut,r0,rlamb,rr
9540 if(rr.lt.r_cut-rlamb) then
9542 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9543 gamm=(rr-(r_cut-rlamb))/rlamb
9545 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9547 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9554 c----------------------------------------------------------------------------
9555 subroutine e_saxs(Esaxs_constr)
9557 include 'DIMENSIONS'
9560 include "COMMON.SETUP"
9563 include 'COMMON.SBRIDGE'
9564 include 'COMMON.CHAIN'
9565 include 'COMMON.GEO'
9566 include 'COMMON.LOCAL'
9567 include 'COMMON.INTERACT'
9568 include 'COMMON.VAR'
9569 include 'COMMON.IOUNITS'
9570 include 'COMMON.DERIV'
9571 include 'COMMON.CONTROL'
9572 include 'COMMON.NAMES'
9573 include 'COMMON.FFIELD'
9574 include 'COMMON.LANGEVIN'
9575 include 'COMMON.SAXS'
9577 double precision Esaxs_constr
9578 integer i,iint,j,k,l
9579 double precision PgradC(maxSAXS,3,maxres),
9580 & PgradX(maxSAXS,3,maxres)
9582 double precision PgradC_(maxSAXS,3,maxres),
9583 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9585 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9586 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9587 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9588 & auxX,auxX1,CACAgrad,Cnorm
9589 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9590 double precision dist
9592 c SAXS restraint penalty function
9594 write(iout,*) "------- SAXS penalty function start -------"
9595 write (iout,*) "nsaxs",nsaxs
9596 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9597 write (iout,*) "Psaxs"
9599 write (iout,'(i5,e15.5)') i, Psaxs(i)
9602 Esaxs_constr = 0.0d0
9612 do i=iatsc_s,iatsc_e
9613 if (itype(i).eq.ntyp1) cycle
9614 do iint=1,nint_gr(i)
9615 do j=istart(i,iint),iend(i,iint)
9616 if (itype(j).eq.ntyp1) cycle
9619 dijCASC=dist(i,j+nres)
9620 dijSCCA=dist(i+nres,j)
9621 dijSCSC=dist(i+nres,j+nres)
9622 sigma2CACA=2.0d0/(pstok**2)
9623 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9624 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9625 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9628 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9629 if (itype(j).ne.10) then
9630 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9634 if (itype(i).ne.10) then
9635 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9639 if (itype(i).ne.10 .and. itype(j).ne.10) then
9640 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9644 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9646 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9648 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9649 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9650 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9651 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9654 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9655 PgradC(k,l,i) = PgradC(k,l,i)-aux
9656 PgradC(k,l,j) = PgradC(k,l,j)+aux
9658 if (itype(j).ne.10) then
9659 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9660 PgradC(k,l,i) = PgradC(k,l,i)-aux
9661 PgradC(k,l,j) = PgradC(k,l,j)+aux
9662 PgradX(k,l,j) = PgradX(k,l,j)+aux
9665 if (itype(i).ne.10) then
9666 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9667 PgradX(k,l,i) = PgradX(k,l,i)-aux
9668 PgradC(k,l,i) = PgradC(k,l,i)-aux
9669 PgradC(k,l,j) = PgradC(k,l,j)+aux
9672 if (itype(i).ne.10 .and. itype(j).ne.10) then
9673 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9674 PgradC(k,l,i) = PgradC(k,l,i)-aux
9675 PgradC(k,l,j) = PgradC(k,l,j)+aux
9676 PgradX(k,l,i) = PgradX(k,l,i)-aux
9677 PgradX(k,l,j) = PgradX(k,l,j)+aux
9683 sigma2CACA=scal_rad**2*0.25d0/
9684 & (restok(itype(j))**2+restok(itype(i))**2)
9686 IF (saxs_cutoff.eq.0) THEN
9689 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9690 Pcalc(k) = Pcalc(k)+expCACA
9691 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9693 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9694 PgradC(k,l,i) = PgradC(k,l,i)-aux
9695 PgradC(k,l,j) = PgradC(k,l,j)+aux
9699 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9702 c write (2,*) "ijk",i,j,k
9703 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9704 if (sss2.eq.0.0d0) cycle
9705 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9706 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9707 Pcalc(k) = Pcalc(k)+expCACA
9709 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9711 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9712 & ssgrad2*expCACA/sss2
9715 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9716 PgradC(k,l,i) = PgradC(k,l,i)+aux
9717 PgradC(k,l,j) = PgradC(k,l,j)-aux
9726 if (nfgtasks.gt.1) then
9727 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9728 & MPI_SUM,king,FG_COMM,IERR)
9729 if (fg_rank.eq.king) then
9731 Pcalc(k) = Pcalc_(k)
9734 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9735 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9736 if (fg_rank.eq.king) then
9740 PgradC(k,l,i) = PgradC_(k,l,i)
9746 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9748 if (fg_rank.eq.king) then
9752 PgradX(k,l,i) = PgradX_(k,l,i)
9761 if (fg_rank.eq.king) then
9765 Cnorm = Cnorm + Pcalc(k)
9767 Esaxs_constr = dlog(Cnorm)-wsaxs0
9769 if (Pcalc(k).gt.0.0d0)
9770 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9772 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9776 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9786 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9787 auxC1 = auxC1+PgradC(k,l,i)
9789 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9790 auxX1 = auxX1+PgradX(k,l,i)
9793 gsaxsC(l,i) = auxC - auxC1/Cnorm
9795 gsaxsX(l,i) = auxX - auxX1/Cnorm
9797 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9798 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9806 c----------------------------------------------------------------------------
9807 subroutine e_saxsC(Esaxs_constr)
9809 include 'DIMENSIONS'
9812 include "COMMON.SETUP"
9815 include 'COMMON.SBRIDGE'
9816 include 'COMMON.CHAIN'
9817 include 'COMMON.GEO'
9818 include 'COMMON.LOCAL'
9819 include 'COMMON.INTERACT'
9820 include 'COMMON.VAR'
9821 include 'COMMON.IOUNITS'
9822 include 'COMMON.DERIV'
9823 include 'COMMON.CONTROL'
9824 include 'COMMON.NAMES'
9825 include 'COMMON.FFIELD'
9826 include 'COMMON.LANGEVIN'
9827 include 'COMMON.SAXS'
9829 double precision Esaxs_constr
9830 integer i,iint,j,k,l
9831 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc_,logPtot
9833 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9835 double precision dk,dijCASPH,dijSCSPH,
9836 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9837 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
9839 c SAXS restraint penalty function
9841 write(iout,*) "------- SAXS penalty function start -------"
9842 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
9843 & " isaxs_end",isaxs_end
9844 write (iout,*) "nnt",nnt," ntc",nct
9846 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9847 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9850 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9853 Esaxs_constr = 0.0d0
9855 do j=isaxs_start,isaxs_end
9867 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9869 if (itype(i).ne.10) then
9871 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9874 sigma2CA=2.0d0/pstok**2
9875 sigma2SC=4.0d0/restok(itype(i))**2
9876 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9877 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9878 Pcalc_ = Pcalc_+expCASPH+expSCSPH
9880 write(*,*) "processor i j Pcalc",
9881 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc_
9883 CASPHgrad = sigma2CA*expCASPH
9884 SCSPHgrad = sigma2SC*expSCSPH
9886 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9887 PgradX(l,i) = PgradX(l,i) + aux
9888 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9893 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc_
9894 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc_
9897 logPtot = logPtot - dlog(Pcalc_)
9898 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc_),
9899 c & " logPtot",logPtot
9902 if (nfgtasks.gt.1) then
9903 c write (iout,*) "logPtot before reduction",logPtot
9904 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9905 & MPI_SUM,king,FG_COMM,IERR)
9907 c write (iout,*) "logPtot after reduction",logPtot
9908 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9909 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9910 if (fg_rank.eq.king) then
9913 gsaxsC(l,i) = gsaxsC_(l,i)
9917 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9918 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9919 if (fg_rank.eq.king) then
9922 gsaxsX(l,i) = gsaxsX_(l,i)
9928 Esaxs_constr = logPtot
9931 C--------------------------------------------------------------------------
9932 c MODELLER restraint function
9933 subroutine e_modeller(ehomology_constr)
9934 implicit real*8 (a-h,o-z)
9935 include 'DIMENSIONS'
9936 integer nnn, i, j, k, ki, irec, l
9937 integer katy, odleglosci, test7
9938 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
9939 real*8 distance(max_template),distancek(max_template),
9940 & min_odl,godl(max_template),dih_diff(max_template)
9943 c FP - 30/10/2014 Temporary specifications for homology restraints
9945 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
9947 double precision, dimension (maxres) :: guscdiff,usc_diff
9948 double precision, dimension (max_template) ::
9949 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
9952 include 'COMMON.SBRIDGE'
9953 include 'COMMON.CHAIN'
9954 include 'COMMON.GEO'
9955 include 'COMMON.DERIV'
9956 include 'COMMON.LOCAL'
9957 include 'COMMON.INTERACT'
9958 include 'COMMON.VAR'
9959 include 'COMMON.IOUNITS'
9960 include 'COMMON.CONTROL'
9961 include 'COMMON.HOMRESTR'
9962 include 'COMMON.HOMOLOGY'
9963 include 'COMMON.SETUP'
9964 include 'COMMON.NAMES'
9967 distancek(i)=9999999.9
9972 c Pseudo-energy and gradient from homology restraints (MODELLER-like
9974 C AL 5/2/14 - Introduce list of restraints
9975 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
9977 write(iout,*) "------- dist restrs start -------"
9979 do ii = link_start_homo,link_end_homo
9983 c write (iout,*) "dij(",i,j,") =",dij
9985 do k=1,constr_homology
9986 if(.not.l_homo(k,ii)) then
9990 distance(k)=odl(k,ii)-dij
9991 c write (iout,*) "distance(",k,") =",distance(k)
9993 c For Gaussian-type Urestr
9995 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
9996 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
9997 c write (iout,*) "distancek(",k,") =",distancek(k)
9998 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
10000 c For Lorentzian-type Urestr
10002 if (waga_dist.lt.0.0d0) then
10003 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
10004 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
10005 & (distance(k)**2+sigma_odlir(k,ii)**2))
10009 c min_odl=minval(distancek)
10010 if (nexl.gt.0) then
10013 do kk=1,constr_homology
10014 if(l_homo(kk,ii)) then
10015 min_odl=distancek(kk)
10019 do kk=1,constr_homology
10020 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
10021 & min_odl=distancek(kk)
10024 c write (iout,* )"min_odl",min_odl
10026 write (iout,*) "ij dij",i,j,dij
10027 write (iout,*) "distance",(distance(k),k=1,constr_homology)
10028 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
10029 write (iout,* )"min_odl",min_odl
10034 if (waga_dist.ge.0.0d0) then
10040 do k=1,constr_homology
10041 c Nie wiem po co to liczycie jeszcze raz!
10042 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
10043 c & (2*(sigma_odl(i,j,k))**2))
10044 if(.not.l_homo(k,ii)) cycle
10045 if (waga_dist.ge.0.0d0) then
10047 c For Gaussian-type Urestr
10049 godl(k)=dexp(-distancek(k)+min_odl)
10050 odleg2=odleg2+godl(k)
10052 c For Lorentzian-type Urestr
10055 odleg2=odleg2+distancek(k)
10058 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
10059 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
10060 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
10061 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
10064 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10065 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10067 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
10068 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
10070 if (waga_dist.ge.0.0d0) then
10072 c For Gaussian-type Urestr
10074 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
10076 c For Lorentzian-type Urestr
10079 odleg=odleg+odleg2/constr_homology
10083 c write (iout,*) "odleg",odleg ! sum of -ln-s
10086 c For Gaussian-type Urestr
10088 if (waga_dist.ge.0.0d0) sum_godl=odleg2
10090 do k=1,constr_homology
10091 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10092 c & *waga_dist)+min_odl
10093 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
10095 if(.not.l_homo(k,ii)) cycle
10096 if (waga_dist.ge.0.0d0) then
10097 c For Gaussian-type Urestr
10099 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
10101 c For Lorentzian-type Urestr
10104 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
10105 & sigma_odlir(k,ii)**2)**2)
10107 sum_sgodl=sum_sgodl+sgodl
10109 c sgodl2=sgodl2+sgodl
10110 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
10111 c write(iout,*) "constr_homology=",constr_homology
10112 c write(iout,*) i, j, k, "TEST K"
10114 if (waga_dist.ge.0.0d0) then
10116 c For Gaussian-type Urestr
10118 grad_odl3=waga_homology(iset)*waga_dist
10119 & *sum_sgodl/(sum_godl*dij)
10121 c For Lorentzian-type Urestr
10124 c Original grad expr modified by analogy w Gaussian-type Urestr grad
10125 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
10126 grad_odl3=-waga_homology(iset)*waga_dist*
10127 & sum_sgodl/(constr_homology*dij)
10130 c grad_odl3=sum_sgodl/(sum_godl*dij)
10133 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
10134 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
10135 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
10137 ccc write(iout,*) godl, sgodl, grad_odl3
10139 c grad_odl=grad_odl+grad_odl3
10142 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
10143 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
10144 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
10145 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10146 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
10147 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
10148 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
10149 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
10150 c if (i.eq.25.and.j.eq.27) then
10151 c write(iout,*) "jik",jik,"i",i,"j",j
10152 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
10153 c write(iout,*) "grad_odl3",grad_odl3
10154 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
10155 c write(iout,*) "ggodl",ggodl
10156 c write(iout,*) "ghpbc(",jik,i,")",
10157 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
10162 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
10163 ccc & dLOG(odleg2),"-odleg=", -odleg
10165 enddo ! ii-loop for dist
10167 write(iout,*) "------- dist restrs end -------"
10168 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
10169 c & waga_d.eq.1.0d0) call sum_gradient
10171 c Pseudo-energy and gradient from dihedral-angle restraints from
10172 c homology templates
10173 c write (iout,*) "End of distance loop"
10176 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
10178 write(iout,*) "------- dih restrs start -------"
10179 do i=idihconstr_start_homo,idihconstr_end_homo
10180 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
10183 do i=idihconstr_start_homo,idihconstr_end_homo
10185 c betai=beta(i,i+1,i+2,i+3)
10187 c write (iout,*) "betai =",betai
10188 do k=1,constr_homology
10189 dih_diff(k)=pinorm(dih(k,i)-betai)
10190 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
10191 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
10192 c & -(6.28318-dih_diff(i,k))
10193 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
10194 c & 6.28318+dih_diff(i,k)
10196 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
10198 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
10200 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
10203 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
10206 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
10207 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
10209 write (iout,*) "i",i," betai",betai," kat2",kat2
10210 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
10212 if (kat2.le.1.0d-14) cycle
10213 kat=kat-dLOG(kat2/constr_homology)
10214 c write (iout,*) "kat",kat ! sum of -ln-s
10216 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
10217 ccc & dLOG(kat2), "-kat=", -kat
10220 c ----------------------------------------------------------------------
10222 c ----------------------------------------------------------------------
10226 do k=1,constr_homology
10228 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
10230 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
10232 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
10233 sum_sgdih=sum_sgdih+sgdih
10235 c grad_dih3=sum_sgdih/sum_gdih
10236 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
10238 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
10239 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
10240 ccc & gloc(nphi+i-3,icg)
10241 gloc(i,icg)=gloc(i,icg)+grad_dih3
10242 c if (i.eq.25) then
10243 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
10245 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
10246 ccc & gloc(nphi+i-3,icg)
10248 enddo ! i-loop for dih
10250 write(iout,*) "------- dih restrs end -------"
10253 c Pseudo-energy and gradient for theta angle restraints from
10254 c homology templates
10255 c FP 01/15 - inserted from econstr_local_test.F, loop structure
10259 c For constr_homology reference structures (FP)
10261 c Uconst_back_tot=0.0d0
10264 c Econstr_back legacy
10267 c do i=ithet_start,ithet_end
10270 c do i=loc_start,loc_end
10272 duscdiff(j,i)=0.0d0
10273 duscdiffx(j,i)=0.0d0
10279 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
10280 c write (iout,*) "waga_theta",waga_theta
10281 if (waga_theta.gt.0.0d0) then
10283 write (iout,*) "usampl",usampl
10284 write(iout,*) "------- theta restrs start -------"
10285 c do i=ithet_start,ithet_end
10286 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
10289 c write (iout,*) "maxres",maxres,"nres",nres
10291 do i=ithet_start,ithet_end
10293 c do i=1,nfrag_back
10294 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
10296 c Deviation of theta angles wrt constr_homology ref structures
10298 utheta_i=0.0d0 ! argument of Gaussian for single k
10299 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10300 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
10301 c over residues in a fragment
10302 c write (iout,*) "theta(",i,")=",theta(i)
10303 do k=1,constr_homology
10305 c dtheta_i=theta(j)-thetaref(j,iref)
10306 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
10307 theta_diff(k)=thetatpl(k,i)-theta(i)
10309 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
10310 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
10311 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
10312 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
10313 c Gradient for single Gaussian restraint in subr Econstr_back
10314 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
10317 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
10318 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
10322 c Gradient for multiple Gaussian restraint
10323 sum_gtheta=gutheta_i
10325 do k=1,constr_homology
10326 c New generalized expr for multiple Gaussian from Econstr_back
10327 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
10329 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
10330 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
10333 c Final value of gradient using same var as in Econstr_back
10334 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
10335 & *waga_homology(iset)
10336 c dutheta(i)=sum_sgtheta/sum_gtheta
10338 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
10340 Eval=Eval-dLOG(gutheta_i/constr_homology)
10341 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
10342 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
10343 c Uconst_back=Uconst_back+utheta(i)
10344 enddo ! (i-loop for theta)
10346 write(iout,*) "------- theta restrs end -------"
10350 c Deviation of local SC geometry
10352 c Separation of two i-loops (instructed by AL - 11/3/2014)
10354 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
10355 c write (iout,*) "waga_d",waga_d
10358 write(iout,*) "------- SC restrs start -------"
10359 write (iout,*) "Initial duscdiff,duscdiffx"
10360 do i=loc_start,loc_end
10361 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
10362 & (duscdiffx(jik,i),jik=1,3)
10365 do i=loc_start,loc_end
10366 usc_diff_i=0.0d0 ! argument of Gaussian for single k
10367 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
10368 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
10369 c write(iout,*) "xxtab, yytab, zztab"
10370 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
10371 do k=1,constr_homology
10373 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10374 c Original sign inverted for calc of gradients (s. Econstr_back)
10375 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10376 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10377 c write(iout,*) "dxx, dyy, dzz"
10378 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10380 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
10381 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
10382 c uscdiffk(k)=usc_diff(i)
10383 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
10384 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
10385 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
10386 c & xxref(j),yyref(j),zzref(j)
10391 c Generalized expression for multiple Gaussian acc to that for a single
10392 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
10394 c Original implementation
10395 c sum_guscdiff=guscdiff(i)
10397 c sum_sguscdiff=0.0d0
10398 c do k=1,constr_homology
10399 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
10400 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
10401 c sum_sguscdiff=sum_sguscdiff+sguscdiff
10404 c Implementation of new expressions for gradient (Jan. 2015)
10406 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
10408 do k=1,constr_homology
10410 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
10411 c before. Now the drivatives should be correct
10413 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
10414 c Original sign inverted for calc of gradients (s. Econstr_back)
10415 dyy=-yytpl(k,i)+yytab(i) ! ibid y
10416 dzz=-zztpl(k,i)+zztab(i) ! ibid z
10418 c New implementation
10420 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
10421 & sigma_d(k,i) ! for the grad wrt r'
10422 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
10425 c New implementation
10426 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
10428 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
10429 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
10430 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
10431 duscdiff(jik,i)=duscdiff(jik,i)+
10432 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
10433 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
10434 duscdiffx(jik,i)=duscdiffx(jik,i)+
10435 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
10436 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
10439 write(iout,*) "jik",jik,"i",i
10440 write(iout,*) "dxx, dyy, dzz"
10441 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
10442 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
10443 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
10444 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
10445 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
10446 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
10447 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
10448 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
10449 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
10450 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
10451 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
10452 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
10453 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
10454 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
10455 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
10462 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
10463 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
10465 c write (iout,*) i," uscdiff",uscdiff(i)
10467 c Put together deviations from local geometry
10469 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
10470 c & wfrag_back(3,i,iset)*uscdiff(i)
10471 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
10472 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
10473 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
10474 c Uconst_back=Uconst_back+usc_diff(i)
10476 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
10478 c New implment: multiplied by sum_sguscdiff
10481 enddo ! (i-loop for dscdiff)
10486 write(iout,*) "------- SC restrs end -------"
10487 write (iout,*) "------ After SC loop in e_modeller ------"
10488 do i=loc_start,loc_end
10489 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
10490 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
10492 if (waga_theta.eq.1.0d0) then
10493 write (iout,*) "in e_modeller after SC restr end: dutheta"
10494 do i=ithet_start,ithet_end
10495 write (iout,*) i,dutheta(i)
10498 if (waga_d.eq.1.0d0) then
10499 write (iout,*) "e_modeller after SC loop: duscdiff/x"
10501 write (iout,*) i,(duscdiff(j,i),j=1,3)
10502 write (iout,*) i,(duscdiffx(j,i),j=1,3)
10507 c Total energy from homology restraints
10509 write (iout,*) "odleg",odleg," kat",kat
10510 write (iout,*) "odleg",odleg," kat",kat
10511 write (iout,*) "Eval",Eval," Erot",Erot
10512 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
10513 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
10514 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
10517 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
10519 c ehomology_constr=odleg+kat
10521 c For Lorentzian-type Urestr
10524 if (waga_dist.ge.0.0d0) then
10526 c For Gaussian-type Urestr
10528 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
10529 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10530 ehomology_constr=waga_dist*odleg+waga_angle*kat+
10531 & waga_theta*Eval+waga_d*Erot
10532 c write (iout,*) "ehomology_constr=",ehomology_constr
10535 c For Lorentzian-type Urestr
10537 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
10538 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
10539 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
10540 & waga_theta*Eval+waga_d*Erot
10541 c write (iout,*) "ehomology_constr=",ehomology_constr
10544 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
10545 & "Eval",waga_theta,eval,
10546 & "Erot",waga_d,Erot
10547 write (iout,*) "ehomology_constr",ehomology_constr
10551 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
10552 747 format(a12,i4,i4,i4,f8.3,f8.3)
10553 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
10554 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
10555 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
10556 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)