1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
15 include 'COMMON.FFIELD'
16 include 'COMMON.DERIV'
17 include 'COMMON.INTERACT'
18 include 'COMMON.SBRIDGE'
19 include 'COMMON.CHAIN'
20 include 'COMMON.SHIELD'
21 include 'COMMON.CONTROL'
22 include 'COMMON.TORCNSTR'
23 double precision fact(6)
24 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
26 cd print *,'nnt=',nnt,' nct=',nct
28 C Compute the side-chain and electrostatic interaction energy
30 goto (101,102,103,104,105) ipot
31 C Lennard-Jones potential.
32 101 call elj(evdw,evdw_t)
33 cd print '(a)','Exit ELJ'
35 C Lennard-Jones-Kihara potential (shifted).
36 102 call eljk(evdw,evdw_t)
38 C Berne-Pechukas potential (dilated LJ, angular dependence).
39 103 call ebp(evdw,evdw_t)
41 C Gay-Berne potential (shifted LJ, angular dependence).
42 104 call egb(evdw,evdw_t)
44 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
45 105 call egbv(evdw,evdw_t)
46 C write(iout,*) 'po elektostatyce'
48 C Calculate electrostatic (H-bonding) energy of the main chain.
52 if (shield_mode.eq.1) then
54 else if (shield_mode.eq.2) then
57 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
58 C write(iout,*) 'po eelec'
60 C Calculate excluded-volume interaction energy between peptide groups
63 call escp(evdw2,evdw2_14)
65 c Calculate the bond-stretching energy
69 C write (iout,*) "estr",estr
71 C Calculate the disulfide-bridge and other energy and the contributions
72 C from other distance constraints.
73 cd print *,'Calling EHPB'
75 cd print *,'EHPB exitted succesfully.'
77 C Calculate the virtual-bond-angle energy.
79 C print *,'Bend energy finished.'
81 if (tor_mode.eq.0) then
84 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
92 if (with_theta_constr) call etheta_constr(ethetacnstr)
93 c call ebend(ebe,ethetacnstr)
94 cd print *,'Bend energy finished.'
96 C Calculate the SC local energy.
99 C print *,'SCLOC energy finished.'
101 C Calculate the virtual-bond torsional energy.
103 if (wtor.gt.0.0d0) then
104 if (tor_mode.eq.0) then
105 call etor(etors,fact(1))
107 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
109 call etor_kcc(etors,fact(1))
115 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
116 c print *,"Processor",myrank," computed Utor"
118 C 6/23/01 Calculate double-torsional energy
120 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
121 call etor_d(etors_d,fact(2))
125 c print *,"Processor",myrank," computed Utord"
127 if (wsccor.gt.0.0d0) then
128 call eback_sc_corr(esccor)
133 if (wliptran.gt.0) then
134 call Eliptransfer(eliptran)
140 C 12/1/95 Multi-body terms
144 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
145 & .or. wturn6.gt.0.0d0) then
146 c write(iout,*)"calling multibody_eello"
147 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
148 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
149 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
156 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
157 c write (iout,*) "Calling multibody_hbond"
158 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
161 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
162 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
163 call e_saxs(Esaxs_constr)
164 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
165 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
166 call e_saxsC(Esaxs_constr)
167 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
172 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
173 if (constr_homology.ge.1) then
174 call e_modeller(ehomology_constr)
176 ehomology_constr=0.0d0
179 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
181 C BARTEK for dfa test!
182 if (wdfa_dist.gt.0) call edfad(edfadis)
183 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
184 if (wdfa_tor.gt.0) call edfat(edfator)
185 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
186 if (wdfa_nei.gt.0) call edfan(edfanei)
187 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
188 if (wdfa_beta.gt.0) call edfab(edfabet)
189 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
192 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
194 if (shield_mode.gt.0) then
195 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
197 & +fact(1)*wvdwpp*evdw1
198 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
199 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
200 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
201 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
202 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
203 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr+wsaxs*esaxs_constr
204 & +wliptran*eliptran*esaxs_constr
205 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
208 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
210 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
211 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
212 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
213 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
214 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
215 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
216 & +wliptran*eliptran+wsaxs*esaxs_constr
217 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
221 if (shield_mode.gt.0) then
222 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
223 & +welec*fact(1)*(ees+evdw1)
224 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
225 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
226 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
227 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
228 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
229 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
230 & +wliptran*eliptran+wsaxs*esaxs_constr
231 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
234 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
235 & +welec*fact(1)*(ees+evdw1)
236 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
237 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
238 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
239 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
240 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
241 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
242 & +wliptran*eliptran+wsaxs*esaxs_constr
243 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
250 energia(2)=evdw2-evdw2_14
267 energia(8)=eello_turn3
268 energia(9)=eello_turn4
277 energia(20)=edihcnstr
280 energia(24)=ethetacnstr
281 energia(26)=esaxs_constr
282 energia(27)=ehomology_constr
290 if (isnan(etot).ne.0) energia(0)=1.0d+99
292 if (isnan(etot)) energia(0)=1.0d+99
297 idumm=proc_proc(etot,i)
299 call proc_proc(etot,i)
301 if(i.eq.1)energia(0)=1.0d+99
307 call enerprint(energia,fact)
311 C Sum up the components of the Cartesian gradient.
316 if (shield_mode.eq.0) then
317 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
318 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
320 & wstrain*ghpbc(j,i)+
321 & wcorr*fact(3)*gradcorr(j,i)+
322 & wel_loc*fact(2)*gel_loc(j,i)+
323 & wturn3*fact(2)*gcorr3_turn(j,i)+
324 & wturn4*fact(3)*gcorr4_turn(j,i)+
325 & wcorr5*fact(4)*gradcorr5(j,i)+
326 & wcorr6*fact(5)*gradcorr6(j,i)+
327 & wturn6*fact(5)*gcorr6_turn(j,i)+
328 & wsccor*fact(2)*gsccorc(j,i)+
329 & wliptran*gliptranc(j,i)+
330 & wdfa_dist*gdfad(j,i)+
331 & wdfa_tor*gdfat(j,i)+
332 & wdfa_nei*gdfan(j,i)+
333 & wdfa_beta*gdfab(j,i)
334 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
336 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
337 & wsccor*fact(2)*gsccorx(j,i)
338 & +wliptran*gliptranx(j,i)
340 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
341 & +fact(1)*wscp*gvdwc_scp(j,i)+
342 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
344 & wstrain*ghpbc(j,i)+
345 & wcorr*fact(3)*gradcorr(j,i)+
346 & wel_loc*fact(2)*gel_loc(j,i)+
347 & wturn3*fact(2)*gcorr3_turn(j,i)+
348 & wturn4*fact(3)*gcorr4_turn(j,i)+
349 & wcorr5*fact(4)*gradcorr5(j,i)+
350 & wcorr6*fact(5)*gradcorr6(j,i)+
351 & wturn6*fact(5)*gcorr6_turn(j,i)+
352 & wsccor*fact(2)*gsccorc(j,i)
353 & +wliptran*gliptranc(j,i)
354 & +welec*gshieldc(j,i)
355 & +welec*gshieldc_loc(j,i)
356 & +wcorr*gshieldc_ec(j,i)
357 & +wcorr*gshieldc_loc_ec(j,i)
358 & +wturn3*gshieldc_t3(j,i)
359 & +wturn3*gshieldc_loc_t3(j,i)
360 & +wturn4*gshieldc_t4(j,i)
361 & +wturn4*gshieldc_loc_t4(j,i)
362 & +wel_loc*gshieldc_ll(j,i)
363 & +wel_loc*gshieldc_loc_ll(j,i)+
364 & wdfa_dist*gdfad(j,i)+
365 & wdfa_tor*gdfat(j,i)+
366 & wdfa_nei*gdfan(j,i)+
367 & wdfa_beta*gdfab(j,i)
368 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
369 & +fact(1)*wscp*gradx_scp(j,i)+
371 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
372 & wsccor*fact(2)*gsccorx(j,i)
373 & +wliptran*gliptranx(j,i)
374 & +welec*gshieldx(j,i)
375 & +wcorr*gshieldx_ec(j,i)
376 & +wturn3*gshieldx_t3(j,i)
377 & +wturn4*gshieldx_t4(j,i)
378 & +wel_loc*gshieldx_ll(j,i)
384 if (shield_mode.eq.0) then
385 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
386 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
388 & wcorr*fact(3)*gradcorr(j,i)+
389 & wel_loc*fact(2)*gel_loc(j,i)+
390 & wturn3*fact(2)*gcorr3_turn(j,i)+
391 & wturn4*fact(3)*gcorr4_turn(j,i)+
392 & wcorr5*fact(4)*gradcorr5(j,i)+
393 & wcorr6*fact(5)*gradcorr6(j,i)+
394 & wturn6*fact(5)*gcorr6_turn(j,i)+
395 & wsccor*fact(2)*gsccorc(j,i)
396 & +wliptran*gliptranc(j,i)+
397 & wdfa_dist*gdfad(j,i)+
398 & wdfa_tor*gdfat(j,i)+
399 & wdfa_nei*gdfan(j,i)+
400 & wdfa_beta*gdfab(j,i)
402 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
404 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
405 & wsccor*fact(1)*gsccorx(j,i)
406 & +wliptran*gliptranx(j,i)
408 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
409 & fact(1)*wscp*gvdwc_scp(j,i)+
410 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
412 & wcorr*fact(3)*gradcorr(j,i)+
413 & wel_loc*fact(2)*gel_loc(j,i)+
414 & wturn3*fact(2)*gcorr3_turn(j,i)+
415 & wturn4*fact(3)*gcorr4_turn(j,i)+
416 & wcorr5*fact(4)*gradcorr5(j,i)+
417 & wcorr6*fact(5)*gradcorr6(j,i)+
418 & wturn6*fact(5)*gcorr6_turn(j,i)+
419 & wsccor*fact(2)*gsccorc(j,i)
420 & +wliptran*gliptranc(j,i)
421 & +welec*gshieldc(j,i)
422 & +welec*gshieldc_loc(j,i)
423 & +wcorr*gshieldc_ec(j,i)
424 & +wcorr*gshieldc_loc_ec(j,i)
425 & +wturn3*gshieldc_t3(j,i)
426 & +wturn3*gshieldc_loc_t3(j,i)
427 & +wturn4*gshieldc_t4(j,i)
428 & +wturn4*gshieldc_loc_t4(j,i)
429 & +wel_loc*gshieldc_ll(j,i)
430 & +wel_loc*gshieldc_loc_ll(j,i)+
431 & wdfa_dist*gdfad(j,i)+
432 & wdfa_tor*gdfat(j,i)+
433 & wdfa_nei*gdfan(j,i)+
434 & wdfa_beta*gdfab(j,i)
435 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
436 & fact(1)*wscp*gradx_scp(j,i)+
438 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
439 & wsccor*fact(1)*gsccorx(j,i)
440 & +wliptran*gliptranx(j,i)
441 & +welec*gshieldx(j,i)
442 & +wcorr*gshieldx_ec(j,i)
443 & +wturn3*gshieldx_t3(j,i)
444 & +wturn4*gshieldx_t4(j,i)
445 & +wel_loc*gshieldx_ll(j,i)
454 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
455 & +wcorr5*fact(4)*g_corr5_loc(i)
456 & +wcorr6*fact(5)*g_corr6_loc(i)
457 & +wturn4*fact(3)*gel_loc_turn4(i)
458 & +wturn3*fact(2)*gel_loc_turn3(i)
459 & +wturn6*fact(5)*gel_loc_turn6(i)
460 & +wel_loc*fact(2)*gel_loc_loc(i)
461 c & +wsccor*fact(1)*gsccor_loc(i)
462 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
465 if (dyn_ss) call dyn_set_nss
468 C------------------------------------------------------------------------
469 subroutine enerprint(energia,fact)
470 implicit real*8 (a-h,o-z)
472 include 'DIMENSIONS.ZSCOPT'
473 include 'COMMON.IOUNITS'
474 include 'COMMON.FFIELD'
475 include 'COMMON.SBRIDGE'
476 include 'COMMON.CONTROL'
477 double precision energia(0:max_ene),fact(6)
479 evdw=energia(1)+fact(6)*energia(21)
481 evdw2=energia(2)+energia(17)
493 eello_turn3=energia(8)
494 eello_turn4=energia(9)
495 eello_turn6=energia(10)
502 edihcnstr=energia(20)
504 ethetacnstr=energia(24)
507 ehomology_constr=energia(27)
509 edfadis = energia(28)
510 edfator = energia(29)
511 edfanei = energia(30)
512 edfabet = energia(31)
514 write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
515 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
516 & etors_d,wtor_d*fact(2),ehpb,wstrain,
518 & ecorr,wcorr*fact(3),
519 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
522 & wel_loc*fact(2),eello_turn3,wturn3*fact(2),
523 & eello_turn4,wturn4*fact(3),
525 & eello_turn6,wturn6*fact(5),
527 & esccor,wsccor*fact(1),edihcnstr,
528 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
529 & etube,wtube,esaxs,wsaxs,ehomology_constr,
530 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
533 10 format (/'Virtual-chain energies:'//
534 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
535 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
536 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
537 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
538 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
539 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
540 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
541 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
542 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
543 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
544 & ' (SS bridges & dist. cnstr.)'/
546 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
547 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
548 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
550 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
551 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
552 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
554 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
556 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
557 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
558 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
559 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
560 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
561 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
562 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
563 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
564 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
565 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
566 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
567 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
568 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
569 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
570 & 'ETOT= ',1pE16.6,' (total)')
573 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
574 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
575 & etors_d,wtor_d*fact(2),ehpb,wstrain,
577 & ecorr,wcorr*fact(3),
578 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
580 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
581 & eello_turn4,wturn4*fact(3),
583 & eello_turn6,wturn6*fact(5),
585 & esccor,wsccor*fact(1),edihcnstr,
586 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
587 & etube,wtube,esaxs,wsaxs,ehomology_constr,
588 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
591 10 format (/'Virtual-chain energies:'//
592 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
593 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
594 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
595 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
596 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
597 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
598 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
599 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
600 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
601 & ' (SS bridges & dist. restr.)'/
603 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
604 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
605 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
607 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
608 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
609 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
611 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
613 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
614 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
615 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
616 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
617 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
618 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
619 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
620 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
621 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
622 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
623 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
624 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
625 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
626 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
627 & 'ETOT= ',1pE16.6,' (total)')
631 C-----------------------------------------------------------------------
632 subroutine elj(evdw,evdw_t)
634 C This subroutine calculates the interaction energy of nonbonded side chains
635 C assuming the LJ potential of interaction.
637 implicit real*8 (a-h,o-z)
639 include 'DIMENSIONS.ZSCOPT'
640 include "DIMENSIONS.COMPAR"
641 parameter (accur=1.0d-10)
644 include 'COMMON.LOCAL'
645 include 'COMMON.CHAIN'
646 include 'COMMON.DERIV'
647 include 'COMMON.INTERACT'
648 include 'COMMON.TORSION'
649 include 'COMMON.ENEPS'
650 include 'COMMON.SBRIDGE'
651 include 'COMMON.NAMES'
652 include 'COMMON.IOUNITS'
654 include 'COMMON.CONTACTS'
655 include 'COMMON.CONTMAT'
660 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
664 eneps_temp(j,i)=0.0d0
673 if (itypi.eq.ntyp1) cycle
674 itypi1=iabs(itype(i+1))
681 C Calculate SC interaction energy.
684 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
685 cd & 'iend=',iend(i,iint)
686 do j=istart(i,iint),iend(i,iint)
688 if (itypj.eq.ntyp1) cycle
692 C Change 12/1/95 to calculate four-body interactions
693 rij=xj*xj+yj*yj+zj*zj
697 if (sss1.eq.0.0d0) cycle
698 sssgrad1=sscagrad(sqrij)
699 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
700 eps0ij=eps(itypi,itypj)
705 ij=icant(itypi,itypj)
707 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
708 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
711 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
712 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
713 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
714 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
715 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
716 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
717 if (bb.gt.0.0d0) then
718 evdw=evdw+sss1*evdwij
720 evdw_t=evdw_t+sss1*evdwij
724 C Calculate the components of the gradient in DC and X
726 fac=-rrij*(e1+evdwij)*sss1
727 & +evdwij*sssgrad1/sqrij/expon
732 gvdwx(k,i)=gvdwx(k,i)-gg(k)
733 gvdwx(k,j)=gvdwx(k,j)+gg(k)
737 gvdwc(l,k)=gvdwc(l,k)+gg(l)
743 C 12/1/95, revised on 5/20/97
745 C Calculate the contact function. The ith column of the array JCONT will
746 C contain the numbers of atoms that make contacts with the atom I (of numbers
747 C greater than I). The arrays FACONT and GACONT will contain the values of
748 C the contact function and its derivative.
750 C Uncomment next line, if the correlation interactions include EVDW explicitly.
751 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
752 C Uncomment next line, if the correlation interactions are contact function only
753 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
755 sigij=sigma(itypi,itypj)
756 r0ij=rs0(itypi,itypj)
758 C Check whether the SC's are not too far to make a contact.
761 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
762 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
764 if (fcont.gt.0.0D0) then
765 C If the SC-SC distance if close to sigma, apply spline.
766 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
767 cAdam & fcont1,fprimcont1)
768 cAdam fcont1=1.0d0-fcont1
769 cAdam if (fcont1.gt.0.0d0) then
770 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
771 cAdam fcont=fcont*fcont1
773 C Uncomment following 4 lines to have the geometric average of the epsilon0's
774 cga eps0ij=1.0d0/dsqrt(eps0ij)
776 cga gg(k)=gg(k)*eps0ij
778 cga eps0ij=-evdwij*eps0ij
779 C Uncomment for AL's type of SC correlation interactions.
781 num_conti=num_conti+1
783 facont(num_conti,i)=fcont*eps0ij
784 fprimcont=eps0ij*fprimcont/rij
786 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
787 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
788 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
789 C Uncomment following 3 lines for Skolnick's type of SC correlation.
790 gacont(1,num_conti,i)=-fprimcont*xj
791 gacont(2,num_conti,i)=-fprimcont*yj
792 gacont(3,num_conti,i)=-fprimcont*zj
793 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
794 cd write (iout,'(2i3,3f10.5)')
795 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
803 num_cont(i)=num_conti
809 gvdwc(j,i)=expon*gvdwc(j,i)
810 gvdwx(j,i)=expon*gvdwx(j,i)
814 C******************************************************************************
818 C To save time, the factor of EXPON has been extracted from ALL components
819 C of GVDWC and GRADX. Remember to multiply them by this factor before further
822 C******************************************************************************
825 C-----------------------------------------------------------------------------
826 subroutine eljk(evdw,evdw_t)
828 C This subroutine calculates the interaction energy of nonbonded side chains
829 C assuming the LJK potential of interaction.
831 implicit real*8 (a-h,o-z)
833 include 'DIMENSIONS.ZSCOPT'
834 include "DIMENSIONS.COMPAR"
837 include 'COMMON.LOCAL'
838 include 'COMMON.CHAIN'
839 include 'COMMON.DERIV'
840 include 'COMMON.INTERACT'
841 include 'COMMON.ENEPS'
842 include 'COMMON.IOUNITS'
843 include 'COMMON.NAMES'
848 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
851 eneps_temp(j,i)=0.0d0
858 if (itypi.eq.ntyp1) cycle
859 itypi1=iabs(itype(i+1))
864 C Calculate SC interaction energy.
867 do j=istart(i,iint),iend(i,iint)
869 if (itypj.eq.ntyp1) cycle
873 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
875 e_augm=augm(itypi,itypj)*fac_augm
879 if (sss1.eq.0.0d0) cycle
880 sssgrad1=sscagrad(rij)
881 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
882 fac=r_shift_inv**expon
886 ij=icant(itypi,itypj)
887 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
888 & /dabs(eps(itypi,itypj))
889 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
890 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
891 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
892 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
893 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
894 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
895 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
896 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
897 if (bb.gt.0.0d0) then
898 evdw=evdw+evdwij*sss1
900 evdw_t=evdw_t+evdwij*sss1
904 C Calculate the components of the gradient in DC and X
906 fac=(-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2))*sss1
907 & +evdwij*sssgrad1*r_inv_ij/expon
912 gvdwx(k,i)=gvdwx(k,i)-gg(k)
913 gvdwx(k,j)=gvdwx(k,j)+gg(k)
917 gvdwc(l,k)=gvdwc(l,k)+gg(l)
927 gvdwc(j,i)=expon*gvdwc(j,i)
928 gvdwx(j,i)=expon*gvdwx(j,i)
934 C-----------------------------------------------------------------------------
935 subroutine ebp(evdw,evdw_t)
937 C This subroutine calculates the interaction energy of nonbonded side chains
938 C assuming the Berne-Pechukas potential of interaction.
940 implicit real*8 (a-h,o-z)
942 include 'DIMENSIONS.ZSCOPT'
943 include "DIMENSIONS.COMPAR"
946 include 'COMMON.LOCAL'
947 include 'COMMON.CHAIN'
948 include 'COMMON.DERIV'
949 include 'COMMON.NAMES'
950 include 'COMMON.INTERACT'
951 include 'COMMON.ENEPS'
952 include 'COMMON.IOUNITS'
953 include 'COMMON.CALC'
955 c double precision rrsave(maxdim)
961 eneps_temp(j,i)=0.0d0
966 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
967 c if (icall.eq.0) then
975 if (itypi.eq.ntyp1) cycle
976 itypi1=iabs(itype(i+1))
980 dxi=dc_norm(1,nres+i)
981 dyi=dc_norm(2,nres+i)
982 dzi=dc_norm(3,nres+i)
983 dsci_inv=vbld_inv(i+nres)
985 C Calculate SC interaction energy.
988 do j=istart(i,iint),iend(i,iint)
991 if (itypj.eq.ntyp1) cycle
992 dscj_inv=vbld_inv(j+nres)
993 chi1=chi(itypi,itypj)
994 chi2=chi(itypj,itypi)
1001 alf12=0.5D0*(alf1+alf2)
1002 C For diagnostics only!!!
1015 dxj=dc_norm(1,nres+j)
1016 dyj=dc_norm(2,nres+j)
1017 dzj=dc_norm(3,nres+j)
1018 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1019 cd if (icall.eq.0) then
1025 sss1=sscale(1.0d0/rij)
1026 if (sss1.eq.0.0d0) cycle
1027 sssgrad1=sscagrad(1.0d0/rij)
1029 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1031 C Calculate whole angle-dependent part of epsilon and contributions
1032 C to its derivatives
1033 fac=(rrij*sigsq)**expon2
1036 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1037 eps2der=evdwij*eps3rt
1038 eps3der=evdwij*eps2rt
1039 evdwij=evdwij*eps2rt*eps3rt
1040 ij=icant(itypi,itypj)
1041 aux=eps1*eps2rt**2*eps3rt**2
1042 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
1043 & /dabs(eps(itypi,itypj))
1044 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
1045 if (bb.gt.0.0d0) then
1046 evdw=evdw+sss1*evdwij
1048 evdw_t=evdw_t+sss1*evdwij
1052 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1054 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1055 & restyp(itypi),i,restyp(itypj),j,
1056 & epsi,sigm,chi1,chi2,chip1,chip2,
1057 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1058 & om1,om2,om12,1.0D0/dsqrt(rrij),
1061 C Calculate gradient components.
1062 e1=e1*eps1*eps2rt**2*eps3rt**2
1063 fac=-expon*(e1+evdwij)
1066 & +evdwij*sssgrad1/sss1*rij
1067 C Calculate radial part of the gradient
1071 C Calculate the angular part of the gradient and sum add the contributions
1072 C to the appropriate components of the Cartesian gradient.
1081 C-----------------------------------------------------------------------------
1082 subroutine egb(evdw,evdw_t)
1084 C This subroutine calculates the interaction energy of nonbonded side chains
1085 C assuming the Gay-Berne potential of interaction.
1087 implicit real*8 (a-h,o-z)
1088 include 'DIMENSIONS'
1089 include 'DIMENSIONS.ZSCOPT'
1090 include "DIMENSIONS.COMPAR"
1091 include 'COMMON.CONTROL'
1092 include 'COMMON.GEO'
1093 include 'COMMON.VAR'
1094 include 'COMMON.LOCAL'
1095 include 'COMMON.CHAIN'
1096 include 'COMMON.DERIV'
1097 include 'COMMON.NAMES'
1098 include 'COMMON.INTERACT'
1099 include 'COMMON.ENEPS'
1100 include 'COMMON.IOUNITS'
1101 include 'COMMON.CALC'
1102 include 'COMMON.SBRIDGE'
1105 integer icant,xshift,yshift,zshift
1109 eneps_temp(j,i)=0.0d0
1112 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1116 c if (icall.gt.0) lprn=.true.
1118 do i=iatsc_s,iatsc_e
1119 itypi=iabs(itype(i))
1120 if (itypi.eq.ntyp1) cycle
1121 itypi1=iabs(itype(i+1))
1125 C returning the ith atom to box
1127 if (xi.lt.0) xi=xi+boxxsize
1129 if (yi.lt.0) yi=yi+boxysize
1131 if (zi.lt.0) zi=zi+boxzsize
1132 if ((zi.gt.bordlipbot)
1133 &.and.(zi.lt.bordliptop)) then
1134 C the energy transfer exist
1135 if (zi.lt.buflipbot) then
1136 C what fraction I am in
1138 & ((zi-bordlipbot)/lipbufthick)
1139 C lipbufthick is thickenes of lipid buffore
1140 sslipi=sscalelip(fracinbuf)
1141 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1142 elseif (zi.gt.bufliptop) then
1143 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1144 sslipi=sscalelip(fracinbuf)
1145 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1155 dxi=dc_norm(1,nres+i)
1156 dyi=dc_norm(2,nres+i)
1157 dzi=dc_norm(3,nres+i)
1158 dsci_inv=vbld_inv(i+nres)
1160 C Calculate SC interaction energy.
1162 do iint=1,nint_gr(i)
1163 do j=istart(i,iint),iend(i,iint)
1164 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1165 call dyn_ssbond_ene(i,j,evdwij)
1167 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1168 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1169 C triple bond artifac removal
1170 do k=j+1,iend(i,iint)
1171 C search over all next residues
1172 if (dyn_ss_mask(k)) then
1173 C check if they are cysteins
1174 C write(iout,*) 'k=',k
1175 call triple_ssbond_ene(i,j,k,evdwij)
1176 C call the energy function that removes the artifical triple disulfide
1177 C bond the soubroutine is located in ssMD.F
1179 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1180 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1181 endif!dyn_ss_mask(k)
1185 itypj=iabs(itype(j))
1186 if (itypj.eq.ntyp1) cycle
1187 dscj_inv=vbld_inv(j+nres)
1188 sig0ij=sigma(itypi,itypj)
1189 chi1=chi(itypi,itypj)
1190 chi2=chi(itypj,itypi)
1197 alf12=0.5D0*(alf1+alf2)
1198 C For diagnostics only!!!
1211 C returning jth atom to box
1213 if (xj.lt.0) xj=xj+boxxsize
1215 if (yj.lt.0) yj=yj+boxysize
1217 if (zj.lt.0) zj=zj+boxzsize
1218 if ((zj.gt.bordlipbot)
1219 &.and.(zj.lt.bordliptop)) then
1220 C the energy transfer exist
1221 if (zj.lt.buflipbot) then
1222 C what fraction I am in
1224 & ((zj-bordlipbot)/lipbufthick)
1225 C lipbufthick is thickenes of lipid buffore
1226 sslipj=sscalelip(fracinbuf)
1227 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1228 elseif (zj.gt.bufliptop) then
1229 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1230 sslipj=sscalelip(fracinbuf)
1231 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1240 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1241 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1242 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1243 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1244 C if (aa.ne.aa_aq(itypi,itypj)) then
1246 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1247 C & bb_aq(itypi,itypj)-bb,
1251 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1252 C checking the distance
1253 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1258 C finding the closest
1262 xj=xj_safe+xshift*boxxsize
1263 yj=yj_safe+yshift*boxysize
1264 zj=zj_safe+zshift*boxzsize
1265 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1266 if(dist_temp.lt.dist_init) then
1276 if (subchap.eq.1) then
1286 dxj=dc_norm(1,nres+j)
1287 dyj=dc_norm(2,nres+j)
1288 dzj=dc_norm(3,nres+j)
1289 c write (iout,*) i,j,xj,yj,zj
1290 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1292 sss=sscale(1.0d0/rij)
1293 sssgrad=sscagrad(1.0d0/rij)
1294 if (sss.le.0.0) cycle
1295 C Calculate angle-dependent terms of energy and contributions to their
1300 sig=sig0ij*dsqrt(sigsq)
1301 rij_shift=1.0D0/rij-sig+sig0ij
1302 C I hate to put IF's in the loops, but here don't have another choice!!!!
1303 if (rij_shift.le.0.0D0) then
1308 c---------------------------------------------------------------
1309 rij_shift=1.0D0/rij_shift
1310 fac=rij_shift**expon
1313 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1314 eps2der=evdwij*eps3rt
1315 eps3der=evdwij*eps2rt
1316 evdwij=evdwij*eps2rt*eps3rt
1318 evdw=evdw+evdwij*sss
1320 evdw_t=evdw_t+evdwij*sss
1322 ij=icant(itypi,itypj)
1323 aux=eps1*eps2rt**2*eps3rt**2
1324 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1325 & /dabs(eps(itypi,itypj))
1326 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1327 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1328 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1329 c & aux*e2/eps(itypi,itypj)
1331 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1335 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1336 & restyp(itypi),i,restyp(itypj),j,
1337 & epsi,sigm,chi1,chi2,chip1,chip2,
1338 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1339 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1341 write (iout,*) "partial sum", evdw, evdw_t
1345 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1348 C Calculate gradient components.
1349 e1=e1*eps1*eps2rt**2*eps3rt**2
1350 fac=-expon*(e1+evdwij)*rij_shift
1353 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1354 C Calculate the radial part of the gradient
1358 C Calculate angular part of the gradient.
1361 C write(iout,*) "partial sum", evdw, evdw_t
1368 C-----------------------------------------------------------------------------
1369 subroutine egbv(evdw,evdw_t)
1371 C This subroutine calculates the interaction energy of nonbonded side chains
1372 C assuming the Gay-Berne-Vorobjev potential of interaction.
1374 implicit real*8 (a-h,o-z)
1375 include 'DIMENSIONS'
1376 include 'DIMENSIONS.ZSCOPT'
1377 include "DIMENSIONS.COMPAR"
1378 include 'COMMON.GEO'
1379 include 'COMMON.VAR'
1380 include 'COMMON.LOCAL'
1381 include 'COMMON.CHAIN'
1382 include 'COMMON.DERIV'
1383 include 'COMMON.NAMES'
1384 include 'COMMON.INTERACT'
1385 include 'COMMON.ENEPS'
1386 include 'COMMON.IOUNITS'
1387 include 'COMMON.CALC'
1388 common /srutu/ icall
1394 eneps_temp(j,i)=0.0d0
1399 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1402 c if (icall.gt.0) lprn=.true.
1404 do i=iatsc_s,iatsc_e
1405 itypi=iabs(itype(i))
1406 if (itypi.eq.ntyp1) cycle
1407 itypi1=iabs(itype(i+1))
1411 dxi=dc_norm(1,nres+i)
1412 dyi=dc_norm(2,nres+i)
1413 dzi=dc_norm(3,nres+i)
1414 dsci_inv=vbld_inv(i+nres)
1416 C Calculate SC interaction energy.
1418 do iint=1,nint_gr(i)
1419 do j=istart(i,iint),iend(i,iint)
1421 itypj=iabs(itype(j))
1422 if (itypj.eq.ntyp1) cycle
1423 dscj_inv=vbld_inv(j+nres)
1424 sig0ij=sigma(itypi,itypj)
1425 r0ij=r0(itypi,itypj)
1426 chi1=chi(itypi,itypj)
1427 chi2=chi(itypj,itypi)
1434 alf12=0.5D0*(alf1+alf2)
1435 C For diagnostics only!!!
1448 dxj=dc_norm(1,nres+j)
1449 dyj=dc_norm(2,nres+j)
1450 dzj=dc_norm(3,nres+j)
1451 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1453 sss=sscale(1.0d0/rij)
1454 if (sss.eq.0.0d0) cycle
1455 sssgrad=sscagrad(1.0d0/rij)
1456 C Calculate angle-dependent terms of energy and contributions to their
1460 sig=sig0ij*dsqrt(sigsq)
1461 rij_shift=1.0D0/rij-sig+r0ij
1462 C I hate to put IF's in the loops, but here don't have another choice!!!!
1463 if (rij_shift.le.0.0D0) then
1468 c---------------------------------------------------------------
1469 rij_shift=1.0D0/rij_shift
1470 fac=rij_shift**expon
1473 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1474 eps2der=evdwij*eps3rt
1475 eps3der=evdwij*eps2rt
1476 fac_augm=rrij**expon
1477 e_augm=augm(itypi,itypj)*fac_augm
1478 evdwij=evdwij*eps2rt*eps3rt
1479 if (bb.gt.0.0d0) then
1480 evdw=evdw+(evdwij+e_augm)*sss
1482 evdw_t=evdw_t+(evdwij+e_augm)*sss
1484 ij=icant(itypi,itypj)
1485 aux=eps1*eps2rt**2*eps3rt**2
1486 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1487 & /dabs(eps(itypi,itypj))
1488 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1489 c eneps_temp(ij)=eneps_temp(ij)
1490 c & +(evdwij+e_augm)/eps(itypi,itypj)
1492 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1493 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1494 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1495 c & restyp(itypi),i,restyp(itypj),j,
1496 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1497 c & chi1,chi2,chip1,chip2,
1498 c & eps1,eps2rt**2,eps3rt**2,
1499 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1503 C Calculate gradient components.
1504 e1=e1*eps1*eps2rt**2*eps3rt**2
1505 fac=-expon*(e1+evdwij)*rij_shift
1507 fac=rij*fac-2*expon*rrij*e_augm
1508 fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
1509 C Calculate the radial part of the gradient
1513 C Calculate angular part of the gradient.
1521 C-----------------------------------------------------------------------------
1522 subroutine sc_angular
1523 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1524 C om12. Called by ebp, egb, and egbv.
1526 include 'COMMON.CALC'
1530 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1531 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1532 om12=dxi*dxj+dyi*dyj+dzi*dzj
1534 C Calculate eps1(om12) and its derivative in om12
1535 faceps1=1.0D0-om12*chiom12
1536 faceps1_inv=1.0D0/faceps1
1537 eps1=dsqrt(faceps1_inv)
1538 C Following variable is eps1*deps1/dom12
1539 eps1_om12=faceps1_inv*chiom12
1540 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1545 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1546 sigsq=1.0D0-facsig*faceps1_inv
1547 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1548 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1549 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1550 C Calculate eps2 and its derivatives in om1, om2, and om12.
1553 chipom12=chip12*om12
1554 facp=1.0D0-om12*chipom12
1556 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1557 C Following variable is the square root of eps2
1558 eps2rt=1.0D0-facp1*facp_inv
1559 C Following three variables are the derivatives of the square root of eps
1560 C in om1, om2, and om12.
1561 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1562 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1563 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1564 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1565 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1566 C Calculate whole angle-dependent part of epsilon and contributions
1567 C to its derivatives
1570 C----------------------------------------------------------------------------
1572 implicit real*8 (a-h,o-z)
1573 include 'DIMENSIONS'
1574 include 'DIMENSIONS.ZSCOPT'
1575 include 'COMMON.CHAIN'
1576 include 'COMMON.DERIV'
1577 include 'COMMON.CALC'
1578 double precision dcosom1(3),dcosom2(3)
1579 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1580 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1581 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1582 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1584 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1585 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1588 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1591 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1592 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1593 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1594 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1595 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1596 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1599 C Calculate the components of the gradient in DC and X
1603 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1608 c------------------------------------------------------------------------------
1609 subroutine vec_and_deriv
1610 implicit real*8 (a-h,o-z)
1611 include 'DIMENSIONS'
1612 include 'DIMENSIONS.ZSCOPT'
1613 include 'COMMON.IOUNITS'
1614 include 'COMMON.GEO'
1615 include 'COMMON.VAR'
1616 include 'COMMON.LOCAL'
1617 include 'COMMON.CHAIN'
1618 include 'COMMON.VECTORS'
1619 include 'COMMON.DERIV'
1620 include 'COMMON.INTERACT'
1621 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1622 C Compute the local reference systems. For reference system (i), the
1623 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1624 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1626 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1627 if (i.eq.nres-1) then
1628 C Case of the last full residue
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(nres))
1632 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1633 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1639 C Compute the derivatives of uz
1641 uzder(2,1,1)=-dc_norm(3,i-1)
1642 uzder(3,1,1)= dc_norm(2,i-1)
1643 uzder(1,2,1)= dc_norm(3,i-1)
1645 uzder(3,2,1)=-dc_norm(1,i-1)
1646 uzder(1,3,1)=-dc_norm(2,i-1)
1647 uzder(2,3,1)= dc_norm(1,i-1)
1650 uzder(2,1,2)= dc_norm(3,i)
1651 uzder(3,1,2)=-dc_norm(2,i)
1652 uzder(1,2,2)=-dc_norm(3,i)
1654 uzder(3,2,2)= dc_norm(1,i)
1655 uzder(1,3,2)= dc_norm(2,i)
1656 uzder(2,3,2)=-dc_norm(1,i)
1659 C Compute the Y-axis
1662 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1665 C Compute the derivatives of uy
1668 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1669 & -dc_norm(k,i)*dc_norm(j,i-1)
1670 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1672 uyder(j,j,1)=uyder(j,j,1)-costh
1673 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1678 uygrad(l,k,j,i)=uyder(l,k,j)
1679 uzgrad(l,k,j,i)=uzder(l,k,j)
1683 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1684 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1685 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1686 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1690 C Compute the Z-axis
1691 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1692 costh=dcos(pi-theta(i+2))
1693 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1698 C Compute the derivatives of uz
1700 uzder(2,1,1)=-dc_norm(3,i+1)
1701 uzder(3,1,1)= dc_norm(2,i+1)
1702 uzder(1,2,1)= dc_norm(3,i+1)
1704 uzder(3,2,1)=-dc_norm(1,i+1)
1705 uzder(1,3,1)=-dc_norm(2,i+1)
1706 uzder(2,3,1)= dc_norm(1,i+1)
1709 uzder(2,1,2)= dc_norm(3,i)
1710 uzder(3,1,2)=-dc_norm(2,i)
1711 uzder(1,2,2)=-dc_norm(3,i)
1713 uzder(3,2,2)= dc_norm(1,i)
1714 uzder(1,3,2)= dc_norm(2,i)
1715 uzder(2,3,2)=-dc_norm(1,i)
1718 C Compute the Y-axis
1721 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1724 C Compute the derivatives of uy
1727 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1728 & -dc_norm(k,i)*dc_norm(j,i+1)
1729 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1731 uyder(j,j,1)=uyder(j,j,1)-costh
1732 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1737 uygrad(l,k,j,i)=uyder(l,k,j)
1738 uzgrad(l,k,j,i)=uzder(l,k,j)
1742 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1743 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1744 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1745 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1751 vbld_inv_temp(1)=vbld_inv(i+1)
1752 if (i.lt.nres-1) then
1753 vbld_inv_temp(2)=vbld_inv(i+2)
1755 vbld_inv_temp(2)=vbld_inv(i)
1760 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1761 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1769 C--------------------------------------------------------------------------
1770 subroutine set_matrices
1771 implicit real*8 (a-h,o-z)
1772 include 'DIMENSIONS'
1776 integer status(MPI_STATUS_SIZE)
1778 include 'DIMENSIONS.ZSCOPT'
1779 include 'COMMON.IOUNITS'
1780 include 'COMMON.GEO'
1781 include 'COMMON.VAR'
1782 include 'COMMON.LOCAL'
1783 include 'COMMON.CHAIN'
1784 include 'COMMON.DERIV'
1785 include 'COMMON.INTERACT'
1786 include 'COMMON.CORRMAT'
1787 include 'COMMON.TORSION'
1788 include 'COMMON.VECTORS'
1789 include 'COMMON.FFIELD'
1790 double precision auxvec(2),auxmat(2,2)
1792 C Compute the virtual-bond-torsional-angle dependent quantities needed
1793 C to calculate the el-loc multibody terms of various order.
1795 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1797 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1798 iti = itype2loc(itype(i-2))
1802 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1803 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1804 iti1 = itype2loc(itype(i-1))
1809 cost1=dcos(theta(i-1))
1810 sint1=dsin(theta(i-1))
1812 sint1cub=sint1sq*sint1
1813 sint1cost1=2*sint1*cost1
1815 write (iout,*) "bnew1",i,iti
1816 write (iout,*) (bnew1(k,1,iti),k=1,3)
1817 write (iout,*) (bnew1(k,2,iti),k=1,3)
1818 write (iout,*) "bnew2",i,iti
1819 write (iout,*) (bnew2(k,1,iti),k=1,3)
1820 write (iout,*) (bnew2(k,2,iti),k=1,3)
1823 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1825 gtb1(k,i-2)=cost1*b1k-sint1sq*
1826 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1827 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1829 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1830 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1833 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1834 cc(1,k,i-2)=sint1sq*aux
1835 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1836 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1837 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1838 dd(1,k,i-2)=sint1sq*aux
1839 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1840 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1842 cc(2,1,i-2)=cc(1,2,i-2)
1843 cc(2,2,i-2)=-cc(1,1,i-2)
1844 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1845 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1846 dd(2,1,i-2)=dd(1,2,i-2)
1847 dd(2,2,i-2)=-dd(1,1,i-2)
1848 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1849 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1852 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1853 EE(l,k,i-2)=sint1sq*aux
1855 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1858 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1859 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1860 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1861 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1863 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1864 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1865 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1867 c b1tilde(1,i-2)=b1(1,i-2)
1868 c b1tilde(2,i-2)=-b1(2,i-2)
1869 c b2tilde(1,i-2)=b2(1,i-2)
1870 c b2tilde(2,i-2)=-b2(2,i-2)
1872 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1873 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1874 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1875 write (iout,*) 'theta=', theta(i-1)
1878 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1879 c iti = itype2loc(itype(i-2))
1883 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1884 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1885 c iti1 = itype2loc(itype(i-1))
1895 CC(k,l,i-2)=ccold(k,l,iti)
1896 DD(k,l,i-2)=ddold(k,l,iti)
1897 EE(k,l,i-2)=eeold(k,l,iti)
1901 b1tilde(1,i-2)= b1(1,i-2)
1902 b1tilde(2,i-2)=-b1(2,i-2)
1903 b2tilde(1,i-2)= b2(1,i-2)
1904 b2tilde(2,i-2)=-b2(2,i-2)
1906 Ctilde(1,1,i-2)= CC(1,1,i-2)
1907 Ctilde(1,2,i-2)= CC(1,2,i-2)
1908 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1909 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1911 Dtilde(1,1,i-2)= DD(1,1,i-2)
1912 Dtilde(1,2,i-2)= DD(1,2,i-2)
1913 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1914 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1916 write(iout,*) "i",i," iti",iti
1917 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1918 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1922 if (i .lt. nres+1) then
1959 if (i .gt. 3 .and. i .lt. nres+1) then
1960 obrot_der(1,i-2)=-sin1
1961 obrot_der(2,i-2)= cos1
1962 Ugder(1,1,i-2)= sin1
1963 Ugder(1,2,i-2)=-cos1
1964 Ugder(2,1,i-2)=-cos1
1965 Ugder(2,2,i-2)=-sin1
1968 obrot2_der(1,i-2)=-dwasin2
1969 obrot2_der(2,i-2)= dwacos2
1970 Ug2der(1,1,i-2)= dwasin2
1971 Ug2der(1,2,i-2)=-dwacos2
1972 Ug2der(2,1,i-2)=-dwacos2
1973 Ug2der(2,2,i-2)=-dwasin2
1975 obrot_der(1,i-2)=0.0d0
1976 obrot_der(2,i-2)=0.0d0
1977 Ugder(1,1,i-2)=0.0d0
1978 Ugder(1,2,i-2)=0.0d0
1979 Ugder(2,1,i-2)=0.0d0
1980 Ugder(2,2,i-2)=0.0d0
1981 obrot2_der(1,i-2)=0.0d0
1982 obrot2_der(2,i-2)=0.0d0
1983 Ug2der(1,1,i-2)=0.0d0
1984 Ug2der(1,2,i-2)=0.0d0
1985 Ug2der(2,1,i-2)=0.0d0
1986 Ug2der(2,2,i-2)=0.0d0
1988 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1989 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1990 iti = itype2loc(itype(i-2))
1994 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1995 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1996 iti1 = itype2loc(itype(i-1))
2000 cd write (iout,*) '*******i',i,' iti1',iti
2001 cd write (iout,*) 'b1',b1(:,iti)
2002 cd write (iout,*) 'b2',b2(:,iti)
2003 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2004 c if (i .gt. iatel_s+2) then
2005 if (i .gt. nnt+2) then
2006 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2008 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2009 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2011 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
2012 c & EE(1,2,iti),EE(2,2,i)
2013 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2014 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2015 c write(iout,*) "Macierz EUG",
2016 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2019 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2021 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
2022 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
2023 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2024 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
2025 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
2037 DtUg2(l,k,i-2)=0.0d0
2041 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2042 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2044 muder(k,i-2)=Ub2der(k,i-2)
2046 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2047 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2048 if (itype(i-1).le.ntyp) then
2049 iti1 = itype2loc(itype(i-1))
2057 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2060 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2061 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2062 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2063 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2064 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2065 & ((ee(l,k,i-2),l=1,2),k=1,2)
2067 cd write (iout,*) 'mu1',mu1(:,i-2)
2068 cd write (iout,*) 'mu2',mu2(:,i-2)
2070 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2073 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2074 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2075 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2076 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2077 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2079 C Vectors and matrices dependent on a single virtual-bond dihedral.
2080 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2081 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2082 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2083 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2084 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2086 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2087 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2088 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2089 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2095 C Matrices dependent on two consecutive virtual-bond dihedrals.
2096 C The order of matrices is from left to right.
2097 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2100 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2102 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2103 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2105 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2106 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2108 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2109 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2110 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2117 C--------------------------------------------------------------------------
2118 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2120 C This subroutine calculates the average interaction energy and its gradient
2121 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2122 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2123 C The potential depends both on the distance of peptide-group centers and on
2124 C the orientation of the CA-CA virtual bonds.
2126 implicit real*8 (a-h,o-z)
2130 include 'DIMENSIONS'
2131 include 'DIMENSIONS.ZSCOPT'
2132 include 'COMMON.CONTROL'
2133 include 'COMMON.IOUNITS'
2134 include 'COMMON.GEO'
2135 include 'COMMON.VAR'
2136 include 'COMMON.LOCAL'
2137 include 'COMMON.CHAIN'
2138 include 'COMMON.DERIV'
2139 include 'COMMON.INTERACT'
2141 include 'COMMON.CONTACTS'
2142 include 'COMMON.CONTMAT'
2144 include 'COMMON.CORRMAT'
2145 include 'COMMON.TORSION'
2146 include 'COMMON.VECTORS'
2147 include 'COMMON.FFIELD'
2148 include 'COMMON.TIME1'
2149 include 'COMMON.SPLITELE'
2150 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2151 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2152 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2153 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2154 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2155 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2157 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2159 double precision scal_el /1.0d0/
2161 double precision scal_el /0.5d0/
2164 C 13-go grudnia roku pamietnego...
2165 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2166 & 0.0d0,1.0d0,0.0d0,
2167 & 0.0d0,0.0d0,1.0d0/
2168 cd write(iout,*) 'In EELEC'
2170 cd write(iout,*) 'Type',i
2171 cd write(iout,*) 'B1',B1(:,i)
2172 cd write(iout,*) 'B2',B2(:,i)
2173 cd write(iout,*) 'CC',CC(:,:,i)
2174 cd write(iout,*) 'DD',DD(:,:,i)
2175 cd write(iout,*) 'EE',EE(:,:,i)
2177 cd call check_vecgrad
2179 if (icheckgrad.eq.1) then
2181 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2183 dc_norm(k,i)=dc(k,i)*fac
2185 c write (iout,*) 'i',i,' fac',fac
2188 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2189 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2190 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2191 c call vec_and_deriv
2197 time_mat=time_mat+MPI_Wtime()-time01
2201 cd write (iout,*) 'i=',i
2203 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2206 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2207 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2222 cd print '(a)','Enter EELEC'
2223 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2225 gel_loc_loc(i)=0.0d0
2230 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2232 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2234 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2235 do i=iturn3_start,iturn3_end
2237 C write(iout,*) "tu jest i",i
2238 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2239 C changes suggested by Ana to avoid out of bounds
2240 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2241 c & .or.((i+4).gt.nres)
2242 c & .or.((i-1).le.0)
2243 C end of changes by Ana
2244 C dobra zmiana wycofana
2245 & .or. itype(i+2).eq.ntyp1
2246 & .or. itype(i+3).eq.ntyp1) cycle
2247 C Adam: Instructions below will switch off existing interactions
2249 c if(itype(i-1).eq.ntyp1)cycle
2251 c if(i.LT.nres-3)then
2252 c if (itype(i+4).eq.ntyp1) cycle
2257 dx_normi=dc_norm(1,i)
2258 dy_normi=dc_norm(2,i)
2259 dz_normi=dc_norm(3,i)
2260 xmedi=c(1,i)+0.5d0*dxi
2261 ymedi=c(2,i)+0.5d0*dyi
2262 zmedi=c(3,i)+0.5d0*dzi
2263 xmedi=mod(xmedi,boxxsize)
2264 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2265 ymedi=mod(ymedi,boxysize)
2266 if (ymedi.lt.0) ymedi=ymedi+boxysize
2267 zmedi=mod(zmedi,boxzsize)
2268 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2270 call eelecij(i,i+2,ees,evdw1,eel_loc)
2271 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2273 num_cont_hb(i)=num_conti
2276 do i=iturn4_start,iturn4_end
2278 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2279 C changes suggested by Ana to avoid out of bounds
2280 c & .or.((i+5).gt.nres)
2281 c & .or.((i-1).le.0)
2282 C end of changes suggested by Ana
2283 & .or. itype(i+3).eq.ntyp1
2284 & .or. itype(i+4).eq.ntyp1
2285 c & .or. itype(i+5).eq.ntyp1
2286 c & .or. itype(i).eq.ntyp1
2287 c & .or. itype(i-1).eq.ntyp1
2292 dx_normi=dc_norm(1,i)
2293 dy_normi=dc_norm(2,i)
2294 dz_normi=dc_norm(3,i)
2295 xmedi=c(1,i)+0.5d0*dxi
2296 ymedi=c(2,i)+0.5d0*dyi
2297 zmedi=c(3,i)+0.5d0*dzi
2298 C Return atom into box, boxxsize is size of box in x dimension
2300 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2301 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2302 C Condition for being inside the proper box
2303 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2304 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2308 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2309 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2310 C Condition for being inside the proper box
2311 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2312 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2316 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2317 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2318 C Condition for being inside the proper box
2319 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2320 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2323 xmedi=mod(xmedi,boxxsize)
2324 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2325 ymedi=mod(ymedi,boxysize)
2326 if (ymedi.lt.0) ymedi=ymedi+boxysize
2327 zmedi=mod(zmedi,boxzsize)
2328 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2330 num_conti=num_cont_hb(i)
2332 c write(iout,*) "JESTEM W PETLI"
2333 call eelecij(i,i+3,ees,evdw1,eel_loc)
2334 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2335 & call eturn4(i,eello_turn4)
2337 num_cont_hb(i)=num_conti
2340 C Loop over all neighbouring boxes
2345 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2348 do i=iatel_s,iatel_e
2351 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2352 C changes suggested by Ana to avoid out of bounds
2353 c & .or.((i+2).gt.nres)
2354 c & .or.((i-1).le.0)
2355 C end of changes by Ana
2356 c & .or. itype(i+2).eq.ntyp1
2357 c & .or. itype(i-1).eq.ntyp1
2362 dx_normi=dc_norm(1,i)
2363 dy_normi=dc_norm(2,i)
2364 dz_normi=dc_norm(3,i)
2365 xmedi=c(1,i)+0.5d0*dxi
2366 ymedi=c(2,i)+0.5d0*dyi
2367 zmedi=c(3,i)+0.5d0*dzi
2368 xmedi=mod(xmedi,boxxsize)
2369 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2370 ymedi=mod(ymedi,boxysize)
2371 if (ymedi.lt.0) ymedi=ymedi+boxysize
2372 zmedi=mod(zmedi,boxzsize)
2373 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2374 C xmedi=xmedi+xshift*boxxsize
2375 C ymedi=ymedi+yshift*boxysize
2376 C zmedi=zmedi+zshift*boxzsize
2378 C Return tom into box, boxxsize is size of box in x dimension
2380 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2381 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2382 C Condition for being inside the proper box
2383 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2384 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2388 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2389 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2390 C Condition for being inside the proper box
2391 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2392 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2396 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2397 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2398 cC Condition for being inside the proper box
2399 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2400 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2404 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2406 num_conti=num_cont_hb(i)
2409 do j=ielstart(i),ielend(i)
2411 C write (iout,*) i,j
2413 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2414 C changes suggested by Ana to avoid out of bounds
2415 c & .or.((j+2).gt.nres)
2416 c & .or.((j-1).le.0)
2417 C end of changes by Ana
2418 c & .or.itype(j+2).eq.ntyp1
2419 c & .or.itype(j-1).eq.ntyp1
2421 call eelecij(i,j,ees,evdw1,eel_loc)
2424 num_cont_hb(i)=num_conti
2431 c write (iout,*) "Number of loop steps in EELEC:",ind
2433 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2434 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2436 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2437 ccc eel_loc=eel_loc+eello_turn3
2438 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2441 C-------------------------------------------------------------------------------
2442 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2443 implicit real*8 (a-h,o-z)
2444 include 'DIMENSIONS'
2445 include 'DIMENSIONS.ZSCOPT'
2449 include 'COMMON.CONTROL'
2450 include 'COMMON.IOUNITS'
2451 include 'COMMON.GEO'
2452 include 'COMMON.VAR'
2453 include 'COMMON.LOCAL'
2454 include 'COMMON.CHAIN'
2455 include 'COMMON.DERIV'
2456 include 'COMMON.INTERACT'
2458 include 'COMMON.CONTACTS'
2459 include 'COMMON.CONTMAT'
2461 include 'COMMON.CORRMAT'
2462 include 'COMMON.TORSION'
2463 include 'COMMON.VECTORS'
2464 include 'COMMON.FFIELD'
2465 include 'COMMON.TIME1'
2466 include 'COMMON.SPLITELE'
2467 include 'COMMON.SHIELD'
2468 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2469 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2470 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2471 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2472 & gmuij2(4),gmuji2(4)
2473 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2474 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2476 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2478 double precision scal_el /1.0d0/
2480 double precision scal_el /0.5d0/
2483 C 13-go grudnia roku pamietnego...
2484 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2485 & 0.0d0,1.0d0,0.0d0,
2486 & 0.0d0,0.0d0,1.0d0/
2487 integer xshift,yshift,zshift
2488 c time00=MPI_Wtime()
2489 cd write (iout,*) "eelecij",i,j
2493 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2494 aaa=app(iteli,itelj)
2495 bbb=bpp(iteli,itelj)
2496 ael6i=ael6(iteli,itelj)
2497 ael3i=ael3(iteli,itelj)
2501 dx_normj=dc_norm(1,j)
2502 dy_normj=dc_norm(2,j)
2503 dz_normj=dc_norm(3,j)
2504 C xj=c(1,j)+0.5D0*dxj-xmedi
2505 C yj=c(2,j)+0.5D0*dyj-ymedi
2506 C zj=c(3,j)+0.5D0*dzj-zmedi
2511 if (xj.lt.0) xj=xj+boxxsize
2513 if (yj.lt.0) yj=yj+boxysize
2515 if (zj.lt.0) zj=zj+boxzsize
2516 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2517 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2525 xj=xj_safe+xshift*boxxsize
2526 yj=yj_safe+yshift*boxysize
2527 zj=zj_safe+zshift*boxzsize
2528 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2529 if(dist_temp.lt.dist_init) then
2539 if (isubchap.eq.1) then
2548 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2550 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2551 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2552 C Condition for being inside the proper box
2553 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2554 c & (xj.lt.((-0.5d0)*boxxsize))) then
2558 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2559 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2560 C Condition for being inside the proper box
2561 c if ((yj.gt.((0.5d0)*boxysize)).or.
2562 c & (yj.lt.((-0.5d0)*boxysize))) then
2566 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2567 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2568 C Condition for being inside the proper box
2569 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2570 c & (zj.lt.((-0.5d0)*boxzsize))) then
2573 C endif !endPBC condintion
2577 rij=xj*xj+yj*yj+zj*zj
2579 sss=sscale(sqrt(rij))
2580 if (sss.eq.0.0d0) return
2581 sssgrad=sscagrad(sqrt(rij))
2582 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2583 c & " rlamb",rlamb," sss",sss
2584 c if (sss.gt.0.0d0) then
2590 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2591 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2592 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2593 fac=cosa-3.0D0*cosb*cosg
2595 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2596 if (j.eq.i+2) ev1=scal_el*ev1
2601 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2605 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2606 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2607 if (shield_mode.gt.0) then
2610 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2611 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2620 evdw1=evdw1+evdwij*sss
2621 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2622 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2623 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2624 cd & xmedi,ymedi,zmedi,xj,yj,zj
2626 if (energy_dec) then
2627 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2629 &,iteli,itelj,aaa,evdw1,sss
2630 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2631 &fac_shield(i),fac_shield(j)
2635 C Calculate contributions to the Cartesian gradient.
2638 facvdw=-6*rrmij*(ev1+evdwij)*sss
2639 facel=-3*rrmij*(el1+eesij)
2646 * Radial derivatives. First process both termini of the fragment (i,j)
2652 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2653 & (shield_mode.gt.0)) then
2655 do ilist=1,ishield_list(i)
2656 iresshield=shield_list(ilist,i)
2658 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2660 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2662 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2663 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2664 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2665 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2666 C if (iresshield.gt.i) then
2667 C do ishi=i+1,iresshield-1
2668 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2669 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2673 C do ishi=iresshield,i
2674 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2675 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2681 do ilist=1,ishield_list(j)
2682 iresshield=shield_list(ilist,j)
2684 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2686 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2688 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2689 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2691 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2692 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2693 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2694 C if (iresshield.gt.j) then
2695 C do ishi=j+1,iresshield-1
2696 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2697 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2701 C do ishi=iresshield,j
2702 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2703 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2710 gshieldc(k,i)=gshieldc(k,i)+
2711 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2712 gshieldc(k,j)=gshieldc(k,j)+
2713 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2714 gshieldc(k,i-1)=gshieldc(k,i-1)+
2715 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2716 gshieldc(k,j-1)=gshieldc(k,j-1)+
2717 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2722 c ghalf=0.5D0*ggg(k)
2723 c gelc(k,i)=gelc(k,i)+ghalf
2724 c gelc(k,j)=gelc(k,j)+ghalf
2726 c 9/28/08 AL Gradient compotents will be summed only at the end
2727 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2729 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2730 C & +grad_shield(k,j)*eesij/fac_shield(j)
2731 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2732 C & +grad_shield(k,i)*eesij/fac_shield(i)
2733 C gelc_long(k,i-1)=gelc_long(k,i-1)
2734 C & +grad_shield(k,i)*eesij/fac_shield(i)
2735 C gelc_long(k,j-1)=gelc_long(k,j-1)
2736 C & +grad_shield(k,j)*eesij/fac_shield(j)
2738 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2741 * Loop over residues i+1 thru j-1.
2745 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2748 if (sss.gt.0.0) then
2749 facvdw=facvdw+sssgrad*rmij*evdwij
2759 c ghalf=0.5D0*ggg(k)
2760 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2761 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2763 c 9/28/08 AL Gradient compotents will be summed only at the end
2765 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2766 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2769 * Loop over residues i+1 thru j-1.
2773 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2782 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2783 & +(evdwij+eesij)*sssgrad*rrmij
2788 * Radial derivatives. First process both termini of the fragment (i,j)
2792 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2794 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2796 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2798 c ghalf=0.5D0*ggg(k)
2799 c gelc(k,i)=gelc(k,i)+ghalf
2800 c gelc(k,j)=gelc(k,j)+ghalf
2802 c 9/28/08 AL Gradient compotents will be summed only at the end
2804 gelc_long(k,j)=gelc(k,j)+ggg(k)
2805 gelc_long(k,i)=gelc(k,i)-ggg(k)
2808 * Loop over residues i+1 thru j-1.
2812 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2815 c 9/28/08 AL Gradient compotents will be summed only at the end
2816 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2817 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2818 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2820 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2821 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2829 ecosa=2.0D0*fac3*fac1+fac4
2832 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2833 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2835 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2836 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2838 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2839 cd & (dcosg(k),k=1,3)
2841 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2842 & fac_shield(i)**2*fac_shield(j)**2
2845 c ghalf=0.5D0*ggg(k)
2846 c gelc(k,i)=gelc(k,i)+ghalf
2847 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2848 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2849 c gelc(k,j)=gelc(k,j)+ghalf
2850 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2851 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2855 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2858 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2861 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2862 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2863 & *fac_shield(i)**2*fac_shield(j)**2
2865 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2866 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2867 & *fac_shield(i)**2*fac_shield(j)**2
2868 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2869 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2871 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2876 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2877 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2878 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2880 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2881 C energy of a peptide unit is assumed in the form of a second-order
2882 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2883 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2884 C are computed for EVERY pair of non-contiguous peptide groups.
2887 if (j.lt.nres-1) then
2899 muij(kkk)=mu(k,i)*mu(l,j)
2900 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2903 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2904 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2905 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2906 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2907 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2908 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2914 write (iout,*) 'EELEC: i',i,' j',j
2915 write (iout,*) 'j',j,' j1',j1,' j2',j2
2916 write(iout,*) 'muij',muij
2917 write (iout,*) "uy",uy(:,i)
2918 write (iout,*) "uz",uz(:,j)
2919 write (iout,*) "erij",erij
2921 ury=scalar(uy(1,i),erij)
2922 urz=scalar(uz(1,i),erij)
2923 vry=scalar(uy(1,j),erij)
2924 vrz=scalar(uz(1,j),erij)
2925 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2926 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2927 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2928 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2929 fac=dsqrt(-ael6i)*r3ij
2934 cd write (iout,'(4i5,4f10.5)')
2935 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2936 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2937 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2938 cd & uy(:,j),uz(:,j)
2939 cd write (iout,'(4f10.5)')
2940 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2941 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2942 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2943 cd write (iout,'(9f10.5/)')
2944 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2945 C Derivatives of the elements of A in virtual-bond vectors
2947 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2949 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2950 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2951 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2952 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2953 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2954 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2955 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2956 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2957 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2958 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2959 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2960 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2962 C Compute radial contributions to the gradient
2980 C Add the contributions coming from er
2983 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2984 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2985 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2986 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2989 C Derivatives in DC(i)
2990 cgrad ghalf1=0.5d0*agg(k,1)
2991 cgrad ghalf2=0.5d0*agg(k,2)
2992 cgrad ghalf3=0.5d0*agg(k,3)
2993 cgrad ghalf4=0.5d0*agg(k,4)
2994 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2995 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2996 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2997 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2998 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2999 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3000 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3001 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3002 C Derivatives in DC(i+1)
3003 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3004 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3005 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3006 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3007 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3008 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3009 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3010 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3011 C Derivatives in DC(j)
3012 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3013 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3014 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3015 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3016 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3017 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3018 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3019 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3020 C Derivatives in DC(j+1) or DC(nres-1)
3021 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3022 & -3.0d0*vryg(k,3)*ury)
3023 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3024 & -3.0d0*vrzg(k,3)*ury)
3025 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3026 & -3.0d0*vryg(k,3)*urz)
3027 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3028 & -3.0d0*vrzg(k,3)*urz)
3029 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3031 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3046 aggi(k,l)=-aggi(k,l)
3047 aggi1(k,l)=-aggi1(k,l)
3048 aggj(k,l)=-aggj(k,l)
3049 aggj1(k,l)=-aggj1(k,l)
3053 if (j.lt.nres-1) then
3059 aggi(k,l)=-aggi(k,l)
3060 aggi1(k,l)=-aggi1(k,l)
3061 aggj(k,l)=-aggj(k,l)
3062 aggj1(k,l)=-aggj1(k,l)
3073 aggi(k,l)=-aggi(k,l)
3074 aggi1(k,l)=-aggi1(k,l)
3075 aggj(k,l)=-aggj(k,l)
3076 aggj1(k,l)=-aggj1(k,l)
3081 IF (wel_loc.gt.0.0d0) THEN
3082 C Contribution to the local-electrostatic energy coming from the i-j pair
3083 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3086 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
3088 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
3089 & " wel_loc",wel_loc
3091 if (shield_mode.eq.0) then
3098 eel_loc_ij=eel_loc_ij
3099 & *fac_shield(i)*fac_shield(j)*sss
3100 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3101 & 'eelloc',i,j,eel_loc_ij
3102 c if (eel_loc_ij.ne.0)
3103 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3104 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3106 eel_loc=eel_loc+eel_loc_ij
3107 C Now derivative over eel_loc
3109 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3110 & (shield_mode.gt.0)) then
3113 do ilist=1,ishield_list(i)
3114 iresshield=shield_list(ilist,i)
3116 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
3119 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3121 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
3122 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3126 do ilist=1,ishield_list(j)
3127 iresshield=shield_list(ilist,j)
3129 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
3132 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3134 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3135 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3142 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3143 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3144 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3145 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3146 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3147 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3148 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3149 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3154 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3155 c & ' eel_loc_ij',eel_loc_ij
3156 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3157 C Calculate patrial derivative for theta angle
3159 geel_loc_ij=(a22*gmuij1(1)
3163 & *fac_shield(i)*fac_shield(j)*sss
3164 c write(iout,*) "derivative over thatai"
3165 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3167 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3168 & geel_loc_ij*wel_loc
3169 c write(iout,*) "derivative over thatai-1"
3170 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3177 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3178 & geel_loc_ij*wel_loc
3179 & *fac_shield(i)*fac_shield(j)*sss
3181 c Derivative over j residue
3182 geel_loc_ji=a22*gmuji1(1)
3186 c write(iout,*) "derivative over thataj"
3187 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3190 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3191 & geel_loc_ji*wel_loc
3192 & *fac_shield(i)*fac_shield(j)
3199 c write(iout,*) "derivative over thataj-1"
3200 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3202 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3203 & geel_loc_ji*wel_loc
3204 & *fac_shield(i)*fac_shield(j)*sss
3206 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3208 C Partial derivatives in virtual-bond dihedral angles gamma
3210 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3211 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3212 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3213 & *fac_shield(i)*fac_shield(j)
3215 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3216 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3217 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3218 & *fac_shield(i)*fac_shield(j)
3219 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3220 aux=eel_loc_ij/sss*sssgrad*rmij
3225 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3226 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3227 & *fac_shield(i)*fac_shield(j)*sss
3228 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3229 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3230 cgrad ghalf=0.5d0*ggg(l)
3231 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3232 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3236 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3239 C Remaining derivatives of eello
3241 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3242 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3243 & *fac_shield(i)*fac_shield(j)
3245 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3246 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3247 & *fac_shield(i)*fac_shield(j)
3249 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3250 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3251 & *fac_shield(i)*fac_shield(j)
3253 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3254 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3255 & *fac_shield(i)*fac_shield(j)
3262 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3263 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3265 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3266 & .and. num_conti.le.maxconts) then
3267 c write (iout,*) i,j," entered corr"
3269 C Calculate the contact function. The ith column of the array JCONT will
3270 C contain the numbers of atoms that make contacts with the atom I (of numbers
3271 C greater than I). The arrays FACONT and GACONT will contain the values of
3272 C the contact function and its derivative.
3273 c r0ij=1.02D0*rpp(iteli,itelj)
3274 c r0ij=1.11D0*rpp(iteli,itelj)
3275 r0ij=2.20D0*rpp(iteli,itelj)
3276 c r0ij=1.55D0*rpp(iteli,itelj)
3277 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3278 if (fcont.gt.0.0D0) then
3279 num_conti=num_conti+1
3280 if (num_conti.gt.maxconts) then
3281 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3282 & ' will skip next contacts for this conf.'
3284 jcont_hb(num_conti,i)=j
3285 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3286 cd & " jcont_hb",jcont_hb(num_conti,i)
3287 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3288 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3289 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3291 d_cont(num_conti,i)=rij
3292 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3293 C --- Electrostatic-interaction matrix ---
3294 a_chuj(1,1,num_conti,i)=a22
3295 a_chuj(1,2,num_conti,i)=a23
3296 a_chuj(2,1,num_conti,i)=a32
3297 a_chuj(2,2,num_conti,i)=a33
3298 C --- Gradient of rij
3301 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3308 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3309 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3310 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3311 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3312 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3318 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3319 C Calculate contact energies
3321 wij=cosa-3.0D0*cosb*cosg
3324 c fac3=dsqrt(-ael6i)/r0ij**3
3325 fac3=dsqrt(-ael6i)*r3ij
3326 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3327 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3328 if (ees0tmp.gt.0) then
3329 ees0pij=dsqrt(ees0tmp)
3333 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3334 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3335 if (ees0tmp.gt.0) then
3336 ees0mij=dsqrt(ees0tmp)
3341 if (shield_mode.eq.0) then
3345 ees0plist(num_conti,i)=j
3346 C fac_shield(i)=0.4d0
3347 C fac_shield(j)=0.6d0
3349 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3350 & *fac_shield(i)*fac_shield(j)
3351 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3352 & *fac_shield(i)*fac_shield(j)
3353 C Diagnostics. Comment out or remove after debugging!
3354 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3355 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3356 c ees0m(num_conti,i)=0.0D0
3358 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3359 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3360 C Angular derivatives of the contact function
3362 ees0pij1=fac3/ees0pij
3363 ees0mij1=fac3/ees0mij
3364 fac3p=-3.0D0*fac3*rrmij
3365 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3366 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3368 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3369 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3370 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3371 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3372 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3373 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3374 ecosap=ecosa1+ecosa2
3375 ecosbp=ecosb1+ecosb2
3376 ecosgp=ecosg1+ecosg2
3377 ecosam=ecosa1-ecosa2
3378 ecosbm=ecosb1-ecosb2
3379 ecosgm=ecosg1-ecosg2
3388 facont_hb(num_conti,i)=fcont
3391 fprimcont=fprimcont/rij
3392 cd facont_hb(num_conti,i)=1.0D0
3393 C Following line is for diagnostics.
3396 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3397 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3400 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3401 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3403 gggp(1)=gggp(1)+ees0pijp*xj
3404 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3405 gggp(2)=gggp(2)+ees0pijp*yj
3406 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3407 gggp(3)=gggp(3)+ees0pijp*zj
3408 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3409 gggm(1)=gggm(1)+ees0mijp*xj
3410 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3411 gggm(2)=gggm(2)+ees0mijp*yj
3412 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3413 gggm(3)=gggm(3)+ees0mijp*zj
3414 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3415 C Derivatives due to the contact function
3416 gacont_hbr(1,num_conti,i)=fprimcont*xj
3417 gacont_hbr(2,num_conti,i)=fprimcont*yj
3418 gacont_hbr(3,num_conti,i)=fprimcont*zj
3421 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3422 c following the change of gradient-summation algorithm.
3424 cgrad ghalfp=0.5D0*gggp(k)
3425 cgrad ghalfm=0.5D0*gggm(k)
3426 gacontp_hb1(k,num_conti,i)=!ghalfp
3427 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3428 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3429 & *fac_shield(i)*fac_shield(j)*sss
3431 gacontp_hb2(k,num_conti,i)=!ghalfp
3432 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3433 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3434 & *fac_shield(i)*fac_shield(j)*sss
3436 gacontp_hb3(k,num_conti,i)=gggp(k)
3437 & *fac_shield(i)*fac_shield(j)*sss
3439 gacontm_hb1(k,num_conti,i)=!ghalfm
3440 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3441 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3442 & *fac_shield(i)*fac_shield(j)*sss
3444 gacontm_hb2(k,num_conti,i)=!ghalfm
3445 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3446 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3447 & *fac_shield(i)*fac_shield(j)*sss
3449 gacontm_hb3(k,num_conti,i)=gggm(k)
3450 & *fac_shield(i)*fac_shield(j)*sss
3453 C Diagnostics. Comment out or remove after debugging!
3455 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3456 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3457 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3458 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3459 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3460 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3466 endif ! num_conti.le.maxconts
3471 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3474 ghalf=0.5d0*agg(l,k)
3475 aggi(l,k)=aggi(l,k)+ghalf
3476 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3477 aggj(l,k)=aggj(l,k)+ghalf
3480 if (j.eq.nres-1 .and. i.lt.j-2) then
3483 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3489 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3492 C-----------------------------------------------------------------------------
3493 subroutine eturn3(i,eello_turn3)
3494 C Third- and fourth-order contributions from turns
3495 implicit real*8 (a-h,o-z)
3496 include 'DIMENSIONS'
3497 include 'DIMENSIONS.ZSCOPT'
3498 include 'COMMON.IOUNITS'
3499 include 'COMMON.GEO'
3500 include 'COMMON.VAR'
3501 include 'COMMON.LOCAL'
3502 include 'COMMON.CHAIN'
3503 include 'COMMON.DERIV'
3504 include 'COMMON.INTERACT'
3505 include 'COMMON.CONTACTS'
3506 include 'COMMON.TORSION'
3507 include 'COMMON.VECTORS'
3508 include 'COMMON.FFIELD'
3509 include 'COMMON.CONTROL'
3510 include 'COMMON.SHIELD'
3511 include 'COMMON.CORRMAT'
3513 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3514 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3515 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3516 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3517 & auxgmat2(2,2),auxgmatt2(2,2)
3518 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3519 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3520 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3521 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3524 c write (iout,*) "eturn3",i,j,j1,j2
3529 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3531 C Third-order contributions
3538 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3539 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3540 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3541 c auxalary matices for theta gradient
3542 c auxalary matrix for i+1 and constant i+2
3543 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3544 c auxalary matrix for i+2 and constant i+1
3545 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3546 call transpose2(auxmat(1,1),auxmat1(1,1))
3547 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3548 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3549 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3550 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3551 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3552 if (shield_mode.eq.0) then
3559 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3560 & *fac_shield(i)*fac_shield(j)
3561 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3562 & *fac_shield(i)*fac_shield(j)
3563 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3567 C Derivatives in theta
3568 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3569 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3570 & *fac_shield(i)*fac_shield(j)
3571 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3572 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3573 & *fac_shield(i)*fac_shield(j)
3576 C Derivatives in shield mode
3577 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3578 & (shield_mode.gt.0)) then
3581 do ilist=1,ishield_list(i)
3582 iresshield=shield_list(ilist,i)
3584 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3586 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3588 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3589 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3593 do ilist=1,ishield_list(j)
3594 iresshield=shield_list(ilist,j)
3596 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3598 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3600 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3601 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3608 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3609 & grad_shield(k,i)*eello_t3/fac_shield(i)
3610 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3611 & grad_shield(k,j)*eello_t3/fac_shield(j)
3612 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3613 & grad_shield(k,i)*eello_t3/fac_shield(i)
3614 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3615 & grad_shield(k,j)*eello_t3/fac_shield(j)
3619 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3620 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3621 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3622 cd & ' eello_turn3_num',4*eello_turn3_num
3623 C Derivatives in gamma(i)
3624 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3625 call transpose2(auxmat2(1,1),auxmat3(1,1))
3626 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3627 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3628 & *fac_shield(i)*fac_shield(j)
3629 C Derivatives in gamma(i+1)
3630 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3631 call transpose2(auxmat2(1,1),auxmat3(1,1))
3632 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3633 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3634 & +0.5d0*(pizda(1,1)+pizda(2,2))
3635 & *fac_shield(i)*fac_shield(j)
3636 C Cartesian derivatives
3638 c ghalf1=0.5d0*agg(l,1)
3639 c ghalf2=0.5d0*agg(l,2)
3640 c ghalf3=0.5d0*agg(l,3)
3641 c ghalf4=0.5d0*agg(l,4)
3642 a_temp(1,1)=aggi(l,1)!+ghalf1
3643 a_temp(1,2)=aggi(l,2)!+ghalf2
3644 a_temp(2,1)=aggi(l,3)!+ghalf3
3645 a_temp(2,2)=aggi(l,4)!+ghalf4
3646 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3647 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3648 & +0.5d0*(pizda(1,1)+pizda(2,2))
3649 & *fac_shield(i)*fac_shield(j)
3651 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3652 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3653 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3654 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3655 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3656 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3657 & +0.5d0*(pizda(1,1)+pizda(2,2))
3658 & *fac_shield(i)*fac_shield(j)
3659 a_temp(1,1)=aggj(l,1)!+ghalf1
3660 a_temp(1,2)=aggj(l,2)!+ghalf2
3661 a_temp(2,1)=aggj(l,3)!+ghalf3
3662 a_temp(2,2)=aggj(l,4)!+ghalf4
3663 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3664 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3665 & +0.5d0*(pizda(1,1)+pizda(2,2))
3666 & *fac_shield(i)*fac_shield(j)
3667 a_temp(1,1)=aggj1(l,1)
3668 a_temp(1,2)=aggj1(l,2)
3669 a_temp(2,1)=aggj1(l,3)
3670 a_temp(2,2)=aggj1(l,4)
3671 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3672 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3673 & +0.5d0*(pizda(1,1)+pizda(2,2))
3674 & *fac_shield(i)*fac_shield(j)
3681 C-------------------------------------------------------------------------------
3682 subroutine eturn4(i,eello_turn4)
3683 C Third- and fourth-order contributions from turns
3684 implicit real*8 (a-h,o-z)
3685 include 'DIMENSIONS'
3686 include 'DIMENSIONS.ZSCOPT'
3687 include 'COMMON.IOUNITS'
3688 include 'COMMON.GEO'
3689 include 'COMMON.VAR'
3690 include 'COMMON.LOCAL'
3691 include 'COMMON.CHAIN'
3692 include 'COMMON.DERIV'
3693 include 'COMMON.INTERACT'
3694 include 'COMMON.CONTACTS'
3695 include 'COMMON.TORSION'
3696 include 'COMMON.VECTORS'
3697 include 'COMMON.FFIELD'
3698 include 'COMMON.CONTROL'
3699 include 'COMMON.SHIELD'
3700 include 'COMMON.CORRMAT'
3702 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3703 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3704 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3705 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3706 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3707 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3708 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3709 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3710 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3711 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3712 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3715 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3717 C Fourth-order contributions
3725 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3726 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3727 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3728 c write(iout,*)"WCHODZE W PROGRAM"
3733 iti1=itype2loc(itype(i+1))
3734 iti2=itype2loc(itype(i+2))
3735 iti3=itype2loc(itype(i+3))
3736 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3737 call transpose2(EUg(1,1,i+1),e1t(1,1))
3738 call transpose2(Eug(1,1,i+2),e2t(1,1))
3739 call transpose2(Eug(1,1,i+3),e3t(1,1))
3740 C Ematrix derivative in theta
3741 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3742 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3743 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3744 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3745 c eta1 in derivative theta
3746 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3747 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3748 c auxgvec is derivative of Ub2 so i+3 theta
3749 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3750 c auxalary matrix of E i+1
3751 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3754 s1=scalar2(b1(1,i+2),auxvec(1))
3755 c derivative of theta i+2 with constant i+3
3756 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3757 c derivative of theta i+2 with constant i+2
3758 gs32=scalar2(b1(1,i+2),auxgvec(1))
3759 c derivative of E matix in theta of i+1
3760 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3762 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3763 c ea31 in derivative theta
3764 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3765 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3766 c auxilary matrix auxgvec of Ub2 with constant E matirx
3767 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3768 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3769 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3773 s2=scalar2(b1(1,i+1),auxvec(1))
3774 c derivative of theta i+1 with constant i+3
3775 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3776 c derivative of theta i+2 with constant i+1
3777 gs21=scalar2(b1(1,i+1),auxgvec(1))
3778 c derivative of theta i+3 with constant i+1
3779 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3780 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3782 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3783 c two derivatives over diffetent matrices
3784 c gtae3e2 is derivative over i+3
3785 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3786 c ae3gte2 is derivative over i+2
3787 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3788 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3789 c three possible derivative over theta E matices
3791 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3793 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3795 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3796 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3798 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3799 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3800 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3801 if (shield_mode.eq.0) then
3808 eello_turn4=eello_turn4-(s1+s2+s3)
3809 & *fac_shield(i)*fac_shield(j)
3810 eello_t4=-(s1+s2+s3)
3811 & *fac_shield(i)*fac_shield(j)
3812 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3813 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3814 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3815 C Now derivative over shield:
3816 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3817 & (shield_mode.gt.0)) then
3820 do ilist=1,ishield_list(i)
3821 iresshield=shield_list(ilist,i)
3823 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3825 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3827 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3828 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3832 do ilist=1,ishield_list(j)
3833 iresshield=shield_list(ilist,j)
3835 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3837 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3839 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3840 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3847 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3848 & grad_shield(k,i)*eello_t4/fac_shield(i)
3849 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3850 & grad_shield(k,j)*eello_t4/fac_shield(j)
3851 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3852 & grad_shield(k,i)*eello_t4/fac_shield(i)
3853 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3854 & grad_shield(k,j)*eello_t4/fac_shield(j)
3857 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3858 cd & ' eello_turn4_num',8*eello_turn4_num
3860 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3861 & -(gs13+gsE13+gsEE1)*wturn4
3862 & *fac_shield(i)*fac_shield(j)
3863 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3864 & -(gs23+gs21+gsEE2)*wturn4
3865 & *fac_shield(i)*fac_shield(j)
3867 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3868 & -(gs32+gsE31+gsEE3)*wturn4
3869 & *fac_shield(i)*fac_shield(j)
3871 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3874 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3875 & 'eturn4',i,j,-(s1+s2+s3)
3876 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3877 c & ' eello_turn4_num',8*eello_turn4_num
3878 C Derivatives in gamma(i)
3879 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3880 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3881 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3882 s1=scalar2(b1(1,i+2),auxvec(1))
3883 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3885 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3886 & *fac_shield(i)*fac_shield(j)
3887 C Derivatives in gamma(i+1)
3888 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3889 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3890 s2=scalar2(b1(1,i+1),auxvec(1))
3891 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3892 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3893 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3894 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3895 & *fac_shield(i)*fac_shield(j)
3896 C Derivatives in gamma(i+2)
3897 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3898 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3899 s1=scalar2(b1(1,i+2),auxvec(1))
3900 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3901 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3902 s2=scalar2(b1(1,i+1),auxvec(1))
3903 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3904 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3905 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3906 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3907 & *fac_shield(i)*fac_shield(j)
3909 C Cartesian derivatives
3910 C Derivatives of this turn contributions in DC(i+2)
3911 if (j.lt.nres-1) then
3913 a_temp(1,1)=agg(l,1)
3914 a_temp(1,2)=agg(l,2)
3915 a_temp(2,1)=agg(l,3)
3916 a_temp(2,2)=agg(l,4)
3917 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3918 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3919 s1=scalar2(b1(1,i+2),auxvec(1))
3920 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3921 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3922 s2=scalar2(b1(1,i+1),auxvec(1))
3923 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3924 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3925 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3927 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3928 & *fac_shield(i)*fac_shield(j)
3931 C Remaining derivatives of this turn contribution
3933 a_temp(1,1)=aggi(l,1)
3934 a_temp(1,2)=aggi(l,2)
3935 a_temp(2,1)=aggi(l,3)
3936 a_temp(2,2)=aggi(l,4)
3937 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3938 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3939 s1=scalar2(b1(1,i+2),auxvec(1))
3940 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3941 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3942 s2=scalar2(b1(1,i+1),auxvec(1))
3943 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3944 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3945 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3946 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3947 & *fac_shield(i)*fac_shield(j)
3948 a_temp(1,1)=aggi1(l,1)
3949 a_temp(1,2)=aggi1(l,2)
3950 a_temp(2,1)=aggi1(l,3)
3951 a_temp(2,2)=aggi1(l,4)
3952 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3953 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3954 s1=scalar2(b1(1,i+2),auxvec(1))
3955 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3956 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3957 s2=scalar2(b1(1,i+1),auxvec(1))
3958 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3959 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3960 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3961 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3962 & *fac_shield(i)*fac_shield(j)
3963 a_temp(1,1)=aggj(l,1)
3964 a_temp(1,2)=aggj(l,2)
3965 a_temp(2,1)=aggj(l,3)
3966 a_temp(2,2)=aggj(l,4)
3967 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3968 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3969 s1=scalar2(b1(1,i+2),auxvec(1))
3970 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3971 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3972 s2=scalar2(b1(1,i+1),auxvec(1))
3973 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3974 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3975 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3976 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3977 & *fac_shield(i)*fac_shield(j)
3978 a_temp(1,1)=aggj1(l,1)
3979 a_temp(1,2)=aggj1(l,2)
3980 a_temp(2,1)=aggj1(l,3)
3981 a_temp(2,2)=aggj1(l,4)
3982 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3983 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3984 s1=scalar2(b1(1,i+2),auxvec(1))
3985 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3986 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3987 s2=scalar2(b1(1,i+1),auxvec(1))
3988 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3989 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3990 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3991 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3992 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3993 & *fac_shield(i)*fac_shield(j)
4000 C-----------------------------------------------------------------------------
4001 subroutine vecpr(u,v,w)
4002 implicit real*8(a-h,o-z)
4003 dimension u(3),v(3),w(3)
4004 w(1)=u(2)*v(3)-u(3)*v(2)
4005 w(2)=-u(1)*v(3)+u(3)*v(1)
4006 w(3)=u(1)*v(2)-u(2)*v(1)
4009 C-----------------------------------------------------------------------------
4010 subroutine unormderiv(u,ugrad,unorm,ungrad)
4011 C This subroutine computes the derivatives of a normalized vector u, given
4012 C the derivatives computed without normalization conditions, ugrad. Returns
4015 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4016 double precision vec(3)
4017 double precision scalar
4019 c write (2,*) 'ugrad',ugrad
4022 vec(i)=scalar(ugrad(1,i),u(1))
4024 c write (2,*) 'vec',vec
4027 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4030 c write (2,*) 'ungrad',ungrad
4033 C-----------------------------------------------------------------------------
4034 subroutine escp(evdw2,evdw2_14)
4036 C This subroutine calculates the excluded-volume interaction energy between
4037 C peptide-group centers and side chains and its gradient in virtual-bond and
4038 C side-chain vectors.
4040 implicit real*8 (a-h,o-z)
4041 include 'DIMENSIONS'
4042 include 'DIMENSIONS.ZSCOPT'
4043 include 'COMMON.CONTROL'
4044 include 'COMMON.GEO'
4045 include 'COMMON.VAR'
4046 include 'COMMON.LOCAL'
4047 include 'COMMON.CHAIN'
4048 include 'COMMON.DERIV'
4049 include 'COMMON.INTERACT'
4050 include 'COMMON.FFIELD'
4051 include 'COMMON.IOUNITS'
4055 cd print '(a)','Enter ESCP'
4056 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4057 c & ' scal14',scal14
4058 do i=iatscp_s,iatscp_e
4059 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4061 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4062 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4063 if (iteli.eq.0) goto 1225
4064 xi=0.5D0*(c(1,i)+c(1,i+1))
4065 yi=0.5D0*(c(2,i)+c(2,i+1))
4066 zi=0.5D0*(c(3,i)+c(3,i+1))
4067 C Returning the ith atom to box
4069 if (xi.lt.0) xi=xi+boxxsize
4071 if (yi.lt.0) yi=yi+boxysize
4073 if (zi.lt.0) zi=zi+boxzsize
4074 do iint=1,nscp_gr(i)
4076 do j=iscpstart(i,iint),iscpend(i,iint)
4077 itypj=iabs(itype(j))
4078 if (itypj.eq.ntyp1) cycle
4079 C Uncomment following three lines for SC-p interactions
4083 C Uncomment following three lines for Ca-p interactions
4087 C returning the jth atom to box
4089 if (xj.lt.0) xj=xj+boxxsize
4091 if (yj.lt.0) yj=yj+boxysize
4093 if (zj.lt.0) zj=zj+boxzsize
4094 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4099 C Finding the closest jth atom
4103 xj=xj_safe+xshift*boxxsize
4104 yj=yj_safe+yshift*boxysize
4105 zj=zj_safe+zshift*boxzsize
4106 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4107 if(dist_temp.lt.dist_init) then
4117 if (subchap.eq.1) then
4126 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4127 C sss is scaling function for smoothing the cutoff gradient otherwise
4128 C the gradient would not be continuouse
4129 sss=sscale(1.0d0/(dsqrt(rrij)))
4130 if (sss.le.0.0d0) cycle
4131 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4133 e1=fac*fac*aad(itypj,iteli)
4134 e2=fac*bad(itypj,iteli)
4135 if (iabs(j-i) .le. 2) then
4138 evdw2_14=evdw2_14+(e1+e2)*sss
4141 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4142 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4143 c & bad(itypj,iteli)
4144 evdw2=evdw2+evdwij*sss
4145 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4146 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4151 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4153 fac=-(evdwij+e1)*rrij*sss
4154 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4159 cd write (iout,*) 'j<i'
4160 C Uncomment following three lines for SC-p interactions
4162 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4165 cd write (iout,*) 'j>i'
4168 C Uncomment following line for SC-p interactions
4169 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4173 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4177 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4178 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4181 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4191 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4192 gradx_scp(j,i)=expon*gradx_scp(j,i)
4195 C******************************************************************************
4199 C To save time the factor EXPON has been extracted from ALL components
4200 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4203 C******************************************************************************
4206 C--------------------------------------------------------------------------
4207 subroutine edis(ehpb)
4209 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4211 implicit real*8 (a-h,o-z)
4212 include 'DIMENSIONS'
4213 include 'DIMENSIONS.ZSCOPT'
4214 include 'COMMON.SBRIDGE'
4215 include 'COMMON.CHAIN'
4216 include 'COMMON.DERIV'
4217 include 'COMMON.VAR'
4218 include 'COMMON.INTERACT'
4219 include 'COMMON.CONTROL'
4220 include 'COMMON.IOUNITS'
4221 dimension ggg(3),ggg_peak(3,1000)
4226 c 8/21/18 AL: added explicit restraints on reference coords
4227 c write (iout,*) "restr_on_coord",restr_on_coord
4228 if (restr_on_coord) then
4232 if (itype(i).eq.ntyp1) cycle
4234 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4235 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4237 if (itype(i).ne.10) then
4239 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4240 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4243 if (energy_dec) write (iout,*)
4244 & "i",i," bfac",bfac(i)," ecoor",ecoor
4245 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4250 C write (iout,*) ,"link_end",link_end,constr_dist
4251 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4252 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4253 c & " constr_dist",constr_dist
4254 if (link_end.eq.0.and.link_end_peak.eq.0) return
4255 do i=link_start_peak,link_end_peak
4257 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4258 c & ipeak(1,i),ipeak(2,i)
4259 do ip=ipeak(1,i),ipeak(2,i)
4264 C iii and jjj point to the residues for which the distance is assigned.
4265 c if (ii.gt.nres) then
4272 if (ii.gt.nres) then
4277 if (jj.gt.nres) then
4282 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4283 aux=dexp(-scal_peak*aux)
4284 ehpb_peak=ehpb_peak+aux
4285 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4286 & forcon_peak(ip))*aux/dd
4288 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4290 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4291 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4292 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4294 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4295 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4296 do ip=ipeak(1,i),ipeak(2,i)
4299 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4303 C iii and jjj point to the residues for which the distance is assigned.
4304 if (ii.gt.nres) then
4313 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4318 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4322 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4323 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4327 do i=link_start,link_end
4328 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4329 C CA-CA distance used in regularization of structure.
4332 C iii and jjj point to the residues for which the distance is assigned.
4333 if (ii.gt.nres) then
4338 if (jj.gt.nres) then
4343 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4344 c & dhpb(i),dhpb1(i),forcon(i)
4345 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4346 C distance and angle dependent SS bond potential.
4347 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4348 C & iabs(itype(jjj)).eq.1) then
4349 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4350 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4351 if (.not.dyn_ss .and. i.le.nss) then
4352 C 15/02/13 CC dynamic SSbond - additional check
4353 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4354 & iabs(itype(jjj)).eq.1) then
4355 call ssbond_ene(iii,jjj,eij)
4358 cd write (iout,*) "eij",eij
4359 cd & ' waga=',waga,' fac=',fac
4360 ! else if (ii.gt.nres .and. jj.gt.nres) then
4362 C Calculate the distance between the two points and its difference from the
4365 if (irestr_type(i).eq.11) then
4366 ehpb=ehpb+fordepth(i)!**4.0d0
4367 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4368 fac=fordepth(i)!**4.0d0
4369 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4370 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4371 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4372 & ehpb,irestr_type(i)
4373 else if (irestr_type(i).eq.10) then
4374 c AL 6//19/2018 cross-link restraints
4375 xdis = 0.5d0*(dd/forcon(i))**2
4376 expdis = dexp(-xdis)
4377 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4378 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4379 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4380 c & " wboltzd",wboltzd
4381 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4382 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4383 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4384 & *expdis/(aux*forcon(i)**2)
4385 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4386 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4387 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4388 else if (irestr_type(i).eq.2) then
4389 c Quartic restraints
4390 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4391 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4392 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4393 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4394 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4396 c Quadratic restraints
4398 C Get the force constant corresponding to this distance.
4400 C Calculate the contribution to energy.
4401 ehpb=ehpb+0.5d0*waga*rdis*rdis
4402 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4403 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4404 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4406 C Evaluate gradient.
4410 c Calculate Cartesian gradient
4412 ggg(j)=fac*(c(j,jj)-c(j,ii))
4414 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4415 C If this is a SC-SC distance, we need to calculate the contributions to the
4416 C Cartesian gradient in the SC vectors (ghpbx).
4419 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4424 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4428 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4429 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4435 C--------------------------------------------------------------------------
4436 subroutine ssbond_ene(i,j,eij)
4438 C Calculate the distance and angle dependent SS-bond potential energy
4439 C using a free-energy function derived based on RHF/6-31G** ab initio
4440 C calculations of diethyl disulfide.
4442 C A. Liwo and U. Kozlowska, 11/24/03
4444 implicit real*8 (a-h,o-z)
4445 include 'DIMENSIONS'
4446 include 'DIMENSIONS.ZSCOPT'
4447 include 'COMMON.SBRIDGE'
4448 include 'COMMON.CHAIN'
4449 include 'COMMON.DERIV'
4450 include 'COMMON.LOCAL'
4451 include 'COMMON.INTERACT'
4452 include 'COMMON.VAR'
4453 include 'COMMON.IOUNITS'
4454 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4455 itypi=iabs(itype(i))
4459 dxi=dc_norm(1,nres+i)
4460 dyi=dc_norm(2,nres+i)
4461 dzi=dc_norm(3,nres+i)
4462 dsci_inv=dsc_inv(itypi)
4463 itypj=iabs(itype(j))
4464 dscj_inv=dsc_inv(itypj)
4468 dxj=dc_norm(1,nres+j)
4469 dyj=dc_norm(2,nres+j)
4470 dzj=dc_norm(3,nres+j)
4471 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4476 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4477 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4478 om12=dxi*dxj+dyi*dyj+dzi*dzj
4480 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4481 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4487 deltat12=om2-om1+2.0d0
4489 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4490 & +akct*deltad*deltat12
4491 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4492 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4493 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4494 c & " deltat12",deltat12," eij",eij
4495 ed=2*akcm*deltad+akct*deltat12
4497 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4498 eom1=-2*akth*deltat1-pom1-om2*pom2
4499 eom2= 2*akth*deltat2+pom1-om1*pom2
4502 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4505 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4506 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4507 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4508 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4511 C Calculate the components of the gradient in DC and X
4515 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4520 C--------------------------------------------------------------------------
4521 c MODELLER restraint function
4522 subroutine e_modeller(ehomology_constr)
4523 implicit real*8 (a-h,o-z)
4524 include 'DIMENSIONS'
4525 include 'DIMENSIONS.ZSCOPT'
4526 include 'DIMENSIONS.FREE'
4527 integer nnn, i, j, k, ki, irec, l
4528 integer katy, odleglosci, test7
4529 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
4530 real*8 distance(max_template),distancek(max_template),
4531 & min_odl,godl(max_template),dih_diff(max_template)
4534 c FP - 30/10/2014 Temporary specifications for homology restraints
4536 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
4538 double precision, dimension (maxres) :: guscdiff,usc_diff
4539 double precision, dimension (max_template) ::
4540 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
4543 include 'COMMON.SBRIDGE'
4544 include 'COMMON.CHAIN'
4545 include 'COMMON.GEO'
4546 include 'COMMON.DERIV'
4547 include 'COMMON.LOCAL'
4548 include 'COMMON.INTERACT'
4549 include 'COMMON.VAR'
4550 include 'COMMON.IOUNITS'
4551 include 'COMMON.CONTROL'
4552 include 'COMMON.HOMRESTR'
4553 include 'COMMON.HOMOLOGY'
4554 include 'COMMON.SETUP'
4555 include 'COMMON.NAMES'
4558 distancek(i)=9999999.9
4563 c Pseudo-energy and gradient from homology restraints (MODELLER-like
4565 C AL 5/2/14 - Introduce list of restraints
4566 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
4568 write(iout,*) "------- dist restrs start -------"
4570 do ii = link_start_homo,link_end_homo
4574 c write (iout,*) "dij(",i,j,") =",dij
4576 do k=1,constr_homology
4577 if(.not.l_homo(k,ii)) then
4581 distance(k)=odl(k,ii)-dij
4582 c write (iout,*) "distance(",k,") =",distance(k)
4584 c For Gaussian-type Urestr
4586 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
4587 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
4588 c write (iout,*) "distancek(",k,") =",distancek(k)
4589 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
4591 c For Lorentzian-type Urestr
4593 if (waga_dist.lt.0.0d0) then
4594 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
4595 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
4596 & (distance(k)**2+sigma_odlir(k,ii)**2))
4600 c min_odl=minval(distancek)
4601 do kk=1,constr_homology
4602 if(l_homo(kk,ii)) then
4603 min_odl=distancek(kk)
4607 do kk=1,constr_homology
4608 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
4609 & min_odl=distancek(kk)
4611 c write (iout,* )"min_odl",min_odl
4613 write (iout,*) "ij dij",i,j,dij
4614 write (iout,*) "distance",(distance(k),k=1,constr_homology)
4615 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
4616 write (iout,* )"min_odl",min_odl
4621 if (waga_dist.ge.0.0d0) then
4627 do k=1,constr_homology
4628 c Nie wiem po co to liczycie jeszcze raz!
4629 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
4630 c & (2*(sigma_odl(i,j,k))**2))
4631 if(.not.l_homo(k,ii)) cycle
4632 if (waga_dist.ge.0.0d0) then
4634 c For Gaussian-type Urestr
4636 godl(k)=dexp(-distancek(k)+min_odl)
4637 odleg2=odleg2+godl(k)
4639 c For Lorentzian-type Urestr
4642 odleg2=odleg2+distancek(k)
4645 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
4646 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
4647 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
4648 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
4651 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4652 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4654 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4655 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4657 if (waga_dist.ge.0.0d0) then
4659 c For Gaussian-type Urestr
4661 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
4663 c For Lorentzian-type Urestr
4666 odleg=odleg+odleg2/constr_homology
4670 c write (iout,*) "odleg",odleg ! sum of -ln-s
4673 c For Gaussian-type Urestr
4675 if (waga_dist.ge.0.0d0) sum_godl=odleg2
4677 do k=1,constr_homology
4678 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4679 c & *waga_dist)+min_odl
4680 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
4682 if(.not.l_homo(k,ii)) cycle
4683 if (waga_dist.ge.0.0d0) then
4684 c For Gaussian-type Urestr
4686 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
4688 c For Lorentzian-type Urestr
4691 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
4692 & sigma_odlir(k,ii)**2)**2)
4694 sum_sgodl=sum_sgodl+sgodl
4696 c sgodl2=sgodl2+sgodl
4697 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
4698 c write(iout,*) "constr_homology=",constr_homology
4699 c write(iout,*) i, j, k, "TEST K"
4701 if (waga_dist.ge.0.0d0) then
4703 c For Gaussian-type Urestr
4705 grad_odl3=waga_homology(iset)*waga_dist
4706 & *sum_sgodl/(sum_godl*dij)
4708 c For Lorentzian-type Urestr
4711 c Original grad expr modified by analogy w Gaussian-type Urestr grad
4712 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
4713 grad_odl3=-waga_homology(iset)*waga_dist*
4714 & sum_sgodl/(constr_homology*dij)
4717 c grad_odl3=sum_sgodl/(sum_godl*dij)
4720 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
4721 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
4722 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4724 ccc write(iout,*) godl, sgodl, grad_odl3
4726 c grad_odl=grad_odl+grad_odl3
4729 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
4730 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
4731 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
4732 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4733 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
4734 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
4735 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
4736 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4737 c if (i.eq.25.and.j.eq.27) then
4738 c write(iout,*) "jik",jik,"i",i,"j",j
4739 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
4740 c write(iout,*) "grad_odl3",grad_odl3
4741 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
4742 c write(iout,*) "ggodl",ggodl
4743 c write(iout,*) "ghpbc(",jik,i,")",
4744 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
4749 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
4750 ccc & dLOG(odleg2),"-odleg=", -odleg
4752 enddo ! ii-loop for dist
4754 write(iout,*) "------- dist restrs end -------"
4755 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
4756 c & waga_d.eq.1.0d0) call sum_gradient
4758 c Pseudo-energy and gradient from dihedral-angle restraints from
4759 c homology templates
4760 c write (iout,*) "End of distance loop"
4763 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
4765 write(iout,*) "------- dih restrs start -------"
4766 do i=idihconstr_start_homo,idihconstr_end_homo
4767 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
4770 do i=idihconstr_start_homo,idihconstr_end_homo
4772 c betai=beta(i,i+1,i+2,i+3)
4774 c write (iout,*) "betai =",betai
4775 do k=1,constr_homology
4776 dih_diff(k)=pinorm(dih(k,i)-betai)
4777 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
4778 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
4779 c & -(6.28318-dih_diff(i,k))
4780 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
4781 c & 6.28318+dih_diff(i,k)
4783 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
4785 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
4787 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
4790 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
4793 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
4794 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
4796 write (iout,*) "i",i," betai",betai," kat2",kat2
4797 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
4799 if (kat2.le.1.0d-14) cycle
4800 kat=kat-dLOG(kat2/constr_homology)
4801 c write (iout,*) "kat",kat ! sum of -ln-s
4803 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
4804 ccc & dLOG(kat2), "-kat=", -kat
4807 c ----------------------------------------------------------------------
4809 c ----------------------------------------------------------------------
4813 do k=1,constr_homology
4815 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
4817 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
4819 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
4820 sum_sgdih=sum_sgdih+sgdih
4822 c grad_dih3=sum_sgdih/sum_gdih
4823 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
4825 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
4826 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
4827 ccc & gloc(nphi+i-3,icg)
4828 gloc(i,icg)=gloc(i,icg)+grad_dih3
4830 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
4832 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
4833 ccc & gloc(nphi+i-3,icg)
4835 enddo ! i-loop for dih
4837 write(iout,*) "------- dih restrs end -------"
4840 c Pseudo-energy and gradient for theta angle restraints from
4841 c homology templates
4842 c FP 01/15 - inserted from econstr_local_test.F, loop structure
4846 c For constr_homology reference structures (FP)
4848 c Uconst_back_tot=0.0d0
4851 c Econstr_back legacy
4854 c do i=ithet_start,ithet_end
4857 c do i=loc_start,loc_end
4860 duscdiffx(j,i)=0.0d0
4866 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
4867 c write (iout,*) "waga_theta",waga_theta
4868 if (waga_theta.gt.0.0d0) then
4870 write (iout,*) "usampl",usampl
4871 write(iout,*) "------- theta restrs start -------"
4872 c do i=ithet_start,ithet_end
4873 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
4876 c write (iout,*) "maxres",maxres,"nres",nres
4878 do i=ithet_start,ithet_end
4881 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
4883 c Deviation of theta angles wrt constr_homology ref structures
4885 utheta_i=0.0d0 ! argument of Gaussian for single k
4886 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4887 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
4888 c over residues in a fragment
4889 c write (iout,*) "theta(",i,")=",theta(i)
4890 do k=1,constr_homology
4892 c dtheta_i=theta(j)-thetaref(j,iref)
4893 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
4894 theta_diff(k)=thetatpl(k,i)-theta(i)
4896 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
4897 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
4898 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
4899 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
4900 c Gradient for single Gaussian restraint in subr Econstr_back
4901 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
4904 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
4905 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
4909 c Gradient for multiple Gaussian restraint
4910 sum_gtheta=gutheta_i
4912 do k=1,constr_homology
4913 c New generalized expr for multiple Gaussian from Econstr_back
4914 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
4916 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
4917 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
4920 c Final value of gradient using same var as in Econstr_back
4921 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
4922 & *waga_homology(iset)
4923 c dutheta(i)=sum_sgtheta/sum_gtheta
4925 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
4927 Eval=Eval-dLOG(gutheta_i/constr_homology)
4928 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
4929 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
4930 c Uconst_back=Uconst_back+utheta(i)
4931 enddo ! (i-loop for theta)
4933 write(iout,*) "------- theta restrs end -------"
4937 c Deviation of local SC geometry
4939 c Separation of two i-loops (instructed by AL - 11/3/2014)
4941 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
4942 c write (iout,*) "waga_d",waga_d
4945 write(iout,*) "------- SC restrs start -------"
4946 write (iout,*) "Initial duscdiff,duscdiffx"
4947 do i=loc_start,loc_end
4948 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
4949 & (duscdiffx(jik,i),jik=1,3)
4952 do i=loc_start,loc_end
4953 usc_diff_i=0.0d0 ! argument of Gaussian for single k
4954 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4955 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
4956 c write(iout,*) "xxtab, yytab, zztab"
4957 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
4958 do k=1,constr_homology
4960 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4961 c Original sign inverted for calc of gradients (s. Econstr_back)
4962 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4963 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4964 c write(iout,*) "dxx, dyy, dzz"
4965 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4967 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
4968 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
4969 c uscdiffk(k)=usc_diff(i)
4970 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
4971 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
4972 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
4973 c & xxref(j),yyref(j),zzref(j)
4978 c Generalized expression for multiple Gaussian acc to that for a single
4979 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
4981 c Original implementation
4982 c sum_guscdiff=guscdiff(i)
4984 c sum_sguscdiff=0.0d0
4985 c do k=1,constr_homology
4986 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
4987 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
4988 c sum_sguscdiff=sum_sguscdiff+sguscdiff
4991 c Implementation of new expressions for gradient (Jan. 2015)
4993 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
4995 do k=1,constr_homology
4997 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
4998 c before. Now the drivatives should be correct
5000 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
5001 c Original sign inverted for calc of gradients (s. Econstr_back)
5002 dyy=-yytpl(k,i)+yytab(i) ! ibid y
5003 dzz=-zztpl(k,i)+zztab(i) ! ibid z
5005 c New implementation
5007 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
5008 & sigma_d(k,i) ! for the grad wrt r'
5009 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
5012 c New implementation
5013 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
5015 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
5016 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
5017 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
5018 duscdiff(jik,i)=duscdiff(jik,i)+
5019 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
5020 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
5021 duscdiffx(jik,i)=duscdiffx(jik,i)+
5022 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
5023 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
5026 write(iout,*) "jik",jik,"i",i
5027 write(iout,*) "dxx, dyy, dzz"
5028 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
5029 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
5030 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
5031 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
5032 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
5033 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
5034 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
5035 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
5036 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
5037 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
5038 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
5039 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
5040 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
5041 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
5042 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
5049 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
5050 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
5052 c write (iout,*) i," uscdiff",uscdiff(i)
5054 c Put together deviations from local geometry
5056 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
5057 c & wfrag_back(3,i,iset)*uscdiff(i)
5058 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
5059 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
5060 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
5061 c Uconst_back=Uconst_back+usc_diff(i)
5063 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
5065 c New implment: multiplied by sum_sguscdiff
5068 enddo ! (i-loop for dscdiff)
5073 write(iout,*) "------- SC restrs end -------"
5074 write (iout,*) "------ After SC loop in e_modeller ------"
5075 do i=loc_start,loc_end
5076 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
5077 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
5079 if (waga_theta.eq.1.0d0) then
5080 write (iout,*) "in e_modeller after SC restr end: dutheta"
5081 do i=ithet_start,ithet_end
5082 write (iout,*) i,dutheta(i)
5085 if (waga_d.eq.1.0d0) then
5086 write (iout,*) "e_modeller after SC loop: duscdiff/x"
5088 write (iout,*) i,(duscdiff(j,i),j=1,3)
5089 write (iout,*) i,(duscdiffx(j,i),j=1,3)
5094 c Total energy from homology restraints
5096 write (iout,*) "odleg",odleg," kat",kat
5097 write (iout,*) "odleg",odleg," kat",kat
5098 write (iout,*) "Eval",Eval," Erot",Erot
5099 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
5100 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
5101 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
5104 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
5106 c ehomology_constr=odleg+kat
5108 c For Lorentzian-type Urestr
5111 if (waga_dist.ge.0.0d0) then
5113 c For Gaussian-type Urestr
5115 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
5116 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
5117 ehomology_constr=waga_dist*odleg+waga_angle*kat+
5118 & waga_theta*Eval+waga_d*Erot
5119 c write (iout,*) "ehomology_constr=",ehomology_constr
5122 c For Lorentzian-type Urestr
5124 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
5125 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
5126 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
5127 & waga_theta*Eval+waga_d*Erot
5128 c write (iout,*) "ehomology_constr=",ehomology_constr
5131 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
5132 & "Eval",waga_theta,eval,
5133 & "Erot",waga_d,Erot
5134 write (iout,*) "ehomology_constr",ehomology_constr
5138 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
5139 747 format(a12,i4,i4,i4,f8.3,f8.3)
5140 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
5141 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
5142 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
5143 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
5145 c-----------------------------------------------------------------------
5146 subroutine ebond(estr)
5148 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5150 implicit real*8 (a-h,o-z)
5151 include 'DIMENSIONS'
5152 include 'DIMENSIONS.ZSCOPT'
5153 include 'COMMON.LOCAL'
5154 include 'COMMON.GEO'
5155 include 'COMMON.INTERACT'
5156 include 'COMMON.DERIV'
5157 include 'COMMON.VAR'
5158 include 'COMMON.CHAIN'
5159 include 'COMMON.IOUNITS'
5160 include 'COMMON.NAMES'
5161 include 'COMMON.FFIELD'
5162 include 'COMMON.CONTROL'
5163 double precision u(3),ud(3)
5166 c write (iout,*) "distchainmax",distchainmax
5168 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5169 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5171 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5172 C & *dc(j,i-1)/vbld(i)
5174 C if (energy_dec) write(iout,*)
5175 C & "estr1",i,vbld(i),distchainmax,
5176 C & gnmr1(vbld(i),-1.0d0,distchainmax)
5178 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5179 diff = vbld(i)-vbldpDUM
5180 C write(iout,*) i,diff
5182 diff = vbld(i)-vbldp0
5183 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
5187 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5190 C write (iout,'(a7,i5,4f7.3)')
5191 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5193 estr=0.5d0*AKP*estr+estr1
5195 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5199 if (iti.ne.10 .and. iti.ne.ntyp1) then
5202 diff=vbld(i+nres)-vbldsc0(1,iti)
5203 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5204 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
5205 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5207 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5211 diff=vbld(i+nres)-vbldsc0(j,iti)
5212 ud(j)=aksc(j,iti)*diff
5213 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5227 uprod2=uprod2*u(k)*u(k)
5231 usumsqder=usumsqder+ud(j)*uprod2
5233 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
5234 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
5235 estr=estr+uprod/usum
5237 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5245 C--------------------------------------------------------------------------
5246 subroutine ebend(etheta,ethetacnstr)
5248 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5249 C angles gamma and its derivatives in consecutive thetas and gammas.
5251 implicit real*8 (a-h,o-z)
5252 include 'DIMENSIONS'
5253 include 'DIMENSIONS.ZSCOPT'
5254 include 'COMMON.LOCAL'
5255 include 'COMMON.GEO'
5256 include 'COMMON.INTERACT'
5257 include 'COMMON.DERIV'
5258 include 'COMMON.VAR'
5259 include 'COMMON.CHAIN'
5260 include 'COMMON.IOUNITS'
5261 include 'COMMON.NAMES'
5262 include 'COMMON.FFIELD'
5263 include 'COMMON.TORCNSTR'
5264 common /calcthet/ term1,term2,termm,diffak,ratak,
5265 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5266 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5267 double precision y(2),z(2)
5269 c time11=dexp(-2*time)
5272 c write (iout,*) "nres",nres
5273 c write (*,'(a,i2)') 'EBEND ICG=',icg
5274 c write (iout,*) ithet_start,ithet_end
5275 do i=ithet_start,ithet_end
5276 C if (itype(i-1).eq.ntyp1) cycle
5278 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5279 & .or.itype(i).eq.ntyp1) cycle
5280 C Zero the energy function and its derivative at 0 or pi.
5281 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5283 ichir1=isign(1,itype(i-2))
5284 ichir2=isign(1,itype(i))
5285 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5286 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5287 if (itype(i-1).eq.10) then
5288 itype1=isign(10,itype(i-2))
5289 ichir11=isign(1,itype(i-2))
5290 ichir12=isign(1,itype(i-2))
5291 itype2=isign(10,itype(i))
5292 ichir21=isign(1,itype(i))
5293 ichir22=isign(1,itype(i))
5300 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5304 c call proc_proc(phii,icrc)
5305 if (icrc.eq.1) phii=150.0
5316 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5320 c call proc_proc(phii1,icrc)
5321 if (icrc.eq.1) phii1=150.0
5333 C Calculate the "mean" value of theta from the part of the distribution
5334 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5335 C In following comments this theta will be referred to as t_c.
5336 thet_pred_mean=0.0d0
5338 athetk=athet(k,it,ichir1,ichir2)
5339 bthetk=bthet(k,it,ichir1,ichir2)
5341 athetk=athet(k,itype1,ichir11,ichir12)
5342 bthetk=bthet(k,itype2,ichir21,ichir22)
5344 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5346 c write (iout,*) "thet_pred_mean",thet_pred_mean
5347 dthett=thet_pred_mean*ssd
5348 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5349 c write (iout,*) "thet_pred_mean",thet_pred_mean
5350 C Derivatives of the "mean" values in gamma1 and gamma2.
5351 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5352 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5353 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5354 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5356 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5357 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5358 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5359 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5361 if (theta(i).gt.pi-delta) then
5362 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5364 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5365 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5366 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5368 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5370 else if (theta(i).lt.delta) then
5371 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5372 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5373 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5375 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5376 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5379 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5382 etheta=etheta+ethetai
5383 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5384 c & 'ebend',i,ethetai,theta(i),itype(i)
5385 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5386 c & rad2deg*phii,rad2deg*phii1,ethetai
5387 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5388 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5389 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5393 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5394 do i=1,ntheta_constr
5395 itheta=itheta_constr(i)
5396 thetiii=theta(itheta)
5397 difi=pinorm(thetiii-theta_constr0(i))
5398 if (difi.gt.theta_drange(i)) then
5399 difi=difi-theta_drange(i)
5400 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5401 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5402 & +for_thet_constr(i)*difi**3
5403 else if (difi.lt.-drange(i)) then
5405 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5406 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5407 & +for_thet_constr(i)*difi**3
5411 C if (energy_dec) then
5412 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5413 C & i,itheta,rad2deg*thetiii,
5414 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5415 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5416 C & gloc(itheta+nphi-2,icg)
5419 C Ufff.... We've done all this!!!
5422 C---------------------------------------------------------------------------
5423 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5425 implicit real*8 (a-h,o-z)
5426 include 'DIMENSIONS'
5427 include 'COMMON.LOCAL'
5428 include 'COMMON.IOUNITS'
5429 common /calcthet/ term1,term2,termm,diffak,ratak,
5430 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5431 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5432 C Calculate the contributions to both Gaussian lobes.
5433 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5434 C The "polynomial part" of the "standard deviation" of this part of
5438 sig=sig*thet_pred_mean+polthet(j,it)
5440 C Derivative of the "interior part" of the "standard deviation of the"
5441 C gamma-dependent Gaussian lobe in t_c.
5442 sigtc=3*polthet(3,it)
5444 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5447 C Set the parameters of both Gaussian lobes of the distribution.
5448 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5449 fac=sig*sig+sigc0(it)
5452 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5453 sigsqtc=-4.0D0*sigcsq*sigtc
5454 c print *,i,sig,sigtc,sigsqtc
5455 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5456 sigtc=-sigtc/(fac*fac)
5457 C Following variable is sigma(t_c)**(-2)
5458 sigcsq=sigcsq*sigcsq
5460 sig0inv=1.0D0/sig0i**2
5461 delthec=thetai-thet_pred_mean
5462 delthe0=thetai-theta0i
5463 term1=-0.5D0*sigcsq*delthec*delthec
5464 term2=-0.5D0*sig0inv*delthe0*delthe0
5465 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5466 C NaNs in taking the logarithm. We extract the largest exponent which is added
5467 C to the energy (this being the log of the distribution) at the end of energy
5468 C term evaluation for this virtual-bond angle.
5469 if (term1.gt.term2) then
5471 term2=dexp(term2-termm)
5475 term1=dexp(term1-termm)
5478 C The ratio between the gamma-independent and gamma-dependent lobes of
5479 C the distribution is a Gaussian function of thet_pred_mean too.
5480 diffak=gthet(2,it)-thet_pred_mean
5481 ratak=diffak/gthet(3,it)**2
5482 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5483 C Let's differentiate it in thet_pred_mean NOW.
5485 C Now put together the distribution terms to make complete distribution.
5486 termexp=term1+ak*term2
5487 termpre=sigc+ak*sig0i
5488 C Contribution of the bending energy from this theta is just the -log of
5489 C the sum of the contributions from the two lobes and the pre-exponential
5490 C factor. Simple enough, isn't it?
5491 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5492 C NOW the derivatives!!!
5493 C 6/6/97 Take into account the deformation.
5494 E_theta=(delthec*sigcsq*term1
5495 & +ak*delthe0*sig0inv*term2)/termexp
5496 E_tc=((sigtc+aktc*sig0i)/termpre
5497 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5498 & aktc*term2)/termexp)
5501 c-----------------------------------------------------------------------------
5502 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5503 implicit real*8 (a-h,o-z)
5504 include 'DIMENSIONS'
5505 include 'COMMON.LOCAL'
5506 include 'COMMON.IOUNITS'
5507 common /calcthet/ term1,term2,termm,diffak,ratak,
5508 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5509 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5510 delthec=thetai-thet_pred_mean
5511 delthe0=thetai-theta0i
5512 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5513 t3 = thetai-thet_pred_mean
5517 t14 = t12+t6*sigsqtc
5519 t21 = thetai-theta0i
5525 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5526 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5527 & *(-t12*t9-ak*sig0inv*t27)
5531 C--------------------------------------------------------------------------
5532 subroutine ebend(etheta)
5534 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5535 C angles gamma and its derivatives in consecutive thetas and gammas.
5536 C ab initio-derived potentials from
5537 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5539 implicit real*8 (a-h,o-z)
5540 include 'DIMENSIONS'
5541 include 'DIMENSIONS.ZSCOPT'
5542 include 'COMMON.LOCAL'
5543 include 'COMMON.GEO'
5544 include 'COMMON.INTERACT'
5545 include 'COMMON.DERIV'
5546 include 'COMMON.VAR'
5547 include 'COMMON.CHAIN'
5548 include 'COMMON.IOUNITS'
5549 include 'COMMON.NAMES'
5550 include 'COMMON.FFIELD'
5551 include 'COMMON.CONTROL'
5552 include 'COMMON.TORCNSTR'
5553 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5554 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5555 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5556 & sinph1ph2(maxdouble,maxdouble)
5557 logical lprn /.false./, lprn1 /.false./
5559 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5560 do i=ithet_start,ithet_end
5562 C if (itype(i-1).eq.ntyp1) cycle
5564 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5565 & .or.itype(i).eq.ntyp1) cycle
5566 if (iabs(itype(i+1)).eq.20) iblock=2
5567 if (iabs(itype(i+1)).ne.20) iblock=1
5571 theti2=0.5d0*theta(i)
5572 ityp2=ithetyp((itype(i-1)))
5574 coskt(k)=dcos(k*theti2)
5575 sinkt(k)=dsin(k*theti2)
5585 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5588 if (phii.ne.phii) phii=150.0
5592 ityp1=ithetyp((itype(i-2)))
5594 cosph1(k)=dcos(k*phii)
5595 sinph1(k)=dsin(k*phii)
5601 ityp1=ithetyp((itype(i-2)))
5606 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5609 if (phii1.ne.phii1) phii1=150.0
5614 ityp3=ithetyp((itype(i)))
5616 cosph2(k)=dcos(k*phii1)
5617 sinph2(k)=dsin(k*phii1)
5622 ityp3=ithetyp((itype(i)))
5628 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5629 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5631 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5634 ccl=cosph1(l)*cosph2(k-l)
5635 ssl=sinph1(l)*sinph2(k-l)
5636 scl=sinph1(l)*cosph2(k-l)
5637 csl=cosph1(l)*sinph2(k-l)
5638 cosph1ph2(l,k)=ccl-ssl
5639 cosph1ph2(k,l)=ccl+ssl
5640 sinph1ph2(l,k)=scl+csl
5641 sinph1ph2(k,l)=scl-csl
5645 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5646 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5647 write (iout,*) "coskt and sinkt"
5649 write (iout,*) k,coskt(k),sinkt(k)
5653 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5654 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5657 & write (iout,*) "k",k,"
5658 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5659 & " ethetai",ethetai
5662 write (iout,*) "cosph and sinph"
5664 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5666 write (iout,*) "cosph1ph2 and sinph2ph2"
5669 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5670 & sinph1ph2(l,k),sinph1ph2(k,l)
5673 write(iout,*) "ethetai",ethetai
5677 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5678 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5679 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5680 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5681 ethetai=ethetai+sinkt(m)*aux
5682 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5683 dephii=dephii+k*sinkt(m)*(
5684 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5685 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5686 dephii1=dephii1+k*sinkt(m)*(
5687 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5688 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5690 & write (iout,*) "m",m," k",k," bbthet",
5691 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5692 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5693 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5694 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5698 & write(iout,*) "ethetai",ethetai
5702 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5703 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5704 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5705 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5706 ethetai=ethetai+sinkt(m)*aux
5707 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5708 dephii=dephii+l*sinkt(m)*(
5709 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5710 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5711 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5712 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5713 dephii1=dephii1+(k-l)*sinkt(m)*(
5714 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5715 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5716 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5717 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5719 write (iout,*) "m",m," k",k," l",l," ffthet",
5720 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5721 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5722 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5723 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5724 & " ethetai",ethetai
5725 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5726 & cosph1ph2(k,l)*sinkt(m),
5727 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5733 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5734 & i,theta(i)*rad2deg,phii*rad2deg,
5735 & phii1*rad2deg,ethetai
5736 etheta=etheta+ethetai
5737 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5738 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5739 c gloc(nphi+i-2,icg)=wang*dethetai
5740 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5746 c-----------------------------------------------------------------------------
5747 subroutine esc(escloc)
5748 C Calculate the local energy of a side chain and its derivatives in the
5749 C corresponding virtual-bond valence angles THETA and the spherical angles
5751 implicit real*8 (a-h,o-z)
5752 include 'DIMENSIONS'
5753 include 'DIMENSIONS.ZSCOPT'
5754 include 'COMMON.GEO'
5755 include 'COMMON.LOCAL'
5756 include 'COMMON.VAR'
5757 include 'COMMON.INTERACT'
5758 include 'COMMON.DERIV'
5759 include 'COMMON.CHAIN'
5760 include 'COMMON.IOUNITS'
5761 include 'COMMON.NAMES'
5762 include 'COMMON.FFIELD'
5763 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5764 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5765 common /sccalc/ time11,time12,time112,theti,it,nlobit
5768 C write (iout,*) 'ESC'
5769 do i=loc_start,loc_end
5771 if (it.eq.ntyp1) cycle
5772 if (it.eq.10) goto 1
5773 nlobit=nlob(iabs(it))
5774 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5775 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5776 theti=theta(i+1)-pipol
5780 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5782 if (x(2).gt.pi-delta) then
5786 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5788 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5789 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5791 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5792 & ddersc0(1),dersc(1))
5793 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5794 & ddersc0(3),dersc(3))
5796 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5798 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5799 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5800 & dersc0(2),esclocbi,dersc02)
5801 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5803 call splinthet(x(2),0.5d0*delta,ss,ssd)
5808 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5810 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5811 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5813 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5815 c write (iout,*) escloci
5816 else if (x(2).lt.delta) then
5820 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5822 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5823 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5825 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5826 & ddersc0(1),dersc(1))
5827 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5828 & ddersc0(3),dersc(3))
5830 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5832 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5833 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5834 & dersc0(2),esclocbi,dersc02)
5835 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5840 call splinthet(x(2),0.5d0*delta,ss,ssd)
5842 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5844 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5845 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5847 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5848 C write (iout,*) 'i=',i, escloci
5850 call enesc(x,escloci,dersc,ddummy,.false.)
5853 escloc=escloc+escloci
5854 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5855 write (iout,'(a6,i5,0pf7.3)')
5856 & 'escloc',i,escloci
5858 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5860 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5861 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5866 C---------------------------------------------------------------------------
5867 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5868 implicit real*8 (a-h,o-z)
5869 include 'DIMENSIONS'
5870 include 'COMMON.GEO'
5871 include 'COMMON.LOCAL'
5872 include 'COMMON.IOUNITS'
5873 common /sccalc/ time11,time12,time112,theti,it,nlobit
5874 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5875 double precision contr(maxlob,-1:1)
5877 c write (iout,*) 'it=',it,' nlobit=',nlobit
5881 if (mixed) ddersc(j)=0.0d0
5885 C Because of periodicity of the dependence of the SC energy in omega we have
5886 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5887 C To avoid underflows, first compute & store the exponents.
5895 z(k)=x(k)-censc(k,j,it)
5900 Axk=Axk+gaussc(l,k,j,it)*z(l)
5906 expfac=expfac+Ax(k,j,iii)*z(k)
5914 C As in the case of ebend, we want to avoid underflows in exponentiation and
5915 C subsequent NaNs and INFs in energy calculation.
5916 C Find the largest exponent
5920 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5924 cd print *,'it=',it,' emin=',emin
5926 C Compute the contribution to SC energy and derivatives
5930 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5931 cd print *,'j=',j,' expfac=',expfac
5932 escloc_i=escloc_i+expfac
5934 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5938 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5939 & +gaussc(k,2,j,it))*expfac
5946 dersc(1)=dersc(1)/cos(theti)**2
5947 ddersc(1)=ddersc(1)/cos(theti)**2
5950 escloci=-(dlog(escloc_i)-emin)
5952 dersc(j)=dersc(j)/escloc_i
5956 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5961 C------------------------------------------------------------------------------
5962 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5963 implicit real*8 (a-h,o-z)
5964 include 'DIMENSIONS'
5965 include 'COMMON.GEO'
5966 include 'COMMON.LOCAL'
5967 include 'COMMON.IOUNITS'
5968 common /sccalc/ time11,time12,time112,theti,it,nlobit
5969 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5970 double precision contr(maxlob)
5981 z(k)=x(k)-censc(k,j,it)
5987 Axk=Axk+gaussc(l,k,j,it)*z(l)
5993 expfac=expfac+Ax(k,j)*z(k)
5998 C As in the case of ebend, we want to avoid underflows in exponentiation and
5999 C subsequent NaNs and INFs in energy calculation.
6000 C Find the largest exponent
6003 if (emin.gt.contr(j)) emin=contr(j)
6007 C Compute the contribution to SC energy and derivatives
6011 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6012 escloc_i=escloc_i+expfac
6014 dersc(k)=dersc(k)+Ax(k,j)*expfac
6016 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6017 & +gaussc(1,2,j,it))*expfac
6021 dersc(1)=dersc(1)/cos(theti)**2
6022 dersc12=dersc12/cos(theti)**2
6023 escloci=-(dlog(escloc_i)-emin)
6025 dersc(j)=dersc(j)/escloc_i
6027 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6031 c----------------------------------------------------------------------------------
6032 subroutine esc(escloc)
6033 C Calculate the local energy of a side chain and its derivatives in the
6034 C corresponding virtual-bond valence angles THETA and the spherical angles
6035 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6036 C added by Urszula Kozlowska. 07/11/2007
6038 implicit real*8 (a-h,o-z)
6039 include 'DIMENSIONS'
6040 include 'DIMENSIONS.ZSCOPT'
6041 include 'COMMON.GEO'
6042 include 'COMMON.LOCAL'
6043 include 'COMMON.VAR'
6044 include 'COMMON.SCROT'
6045 include 'COMMON.INTERACT'
6046 include 'COMMON.DERIV'
6047 include 'COMMON.CHAIN'
6048 include 'COMMON.IOUNITS'
6049 include 'COMMON.NAMES'
6050 include 'COMMON.FFIELD'
6051 include 'COMMON.CONTROL'
6052 include 'COMMON.VECTORS'
6053 double precision x_prime(3),y_prime(3),z_prime(3)
6054 & , sumene,dsc_i,dp2_i,x(65),
6055 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6056 & de_dxx,de_dyy,de_dzz,de_dt
6057 double precision s1_t,s1_6_t,s2_t,s2_6_t
6059 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6060 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6061 & dt_dCi(3),dt_dCi1(3)
6062 common /sccalc/ time11,time12,time112,theti,it,nlobit
6065 do i=loc_start,loc_end
6066 if (itype(i).eq.ntyp1) cycle
6067 costtab(i+1) =dcos(theta(i+1))
6068 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6069 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6070 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6071 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6072 cosfac=dsqrt(cosfac2)
6073 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6074 sinfac=dsqrt(sinfac2)
6076 if (it.eq.10) goto 1
6078 C Compute the axes of tghe local cartesian coordinates system; store in
6079 c x_prime, y_prime and z_prime
6086 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6087 C & dc_norm(3,i+nres)
6089 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6090 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6093 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6096 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6097 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6098 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6099 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6100 c & " xy",scalar(x_prime(1),y_prime(1)),
6101 c & " xz",scalar(x_prime(1),z_prime(1)),
6102 c & " yy",scalar(y_prime(1),y_prime(1)),
6103 c & " yz",scalar(y_prime(1),z_prime(1)),
6104 c & " zz",scalar(z_prime(1),z_prime(1))
6106 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6107 C to local coordinate system. Store in xx, yy, zz.
6113 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6114 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6115 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6122 C Compute the energy of the ith side cbain
6124 c write (2,*) "xx",xx," yy",yy," zz",zz
6127 x(j) = sc_parmin(j,it)
6130 Cc diagnostics - remove later
6132 yy1 = dsin(alph(2))*dcos(omeg(2))
6133 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
6134 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6135 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6137 C," --- ", xx_w,yy_w,zz_w
6140 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6141 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6143 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6144 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6146 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6147 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6148 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6149 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6150 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6152 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6153 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6154 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6155 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6156 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6158 dsc_i = 0.743d0+x(61)
6160 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6161 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6162 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6163 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6164 s1=(1+x(63))/(0.1d0 + dscp1)
6165 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6166 s2=(1+x(65))/(0.1d0 + dscp2)
6167 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6168 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6169 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6170 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6172 c & dscp1,dscp2,sumene
6173 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6174 escloc = escloc + sumene
6175 c write (2,*) "escloc",escloc
6176 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
6178 if (.not. calc_grad) goto 1
6181 C This section to check the numerical derivatives of the energy of ith side
6182 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6183 C #define DEBUG in the code to turn it on.
6185 write (2,*) "sumene =",sumene
6189 write (2,*) xx,yy,zz
6190 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6191 de_dxx_num=(sumenep-sumene)/aincr
6193 write (2,*) "xx+ sumene from enesc=",sumenep
6196 write (2,*) xx,yy,zz
6197 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6198 de_dyy_num=(sumenep-sumene)/aincr
6200 write (2,*) "yy+ sumene from enesc=",sumenep
6203 write (2,*) xx,yy,zz
6204 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6205 de_dzz_num=(sumenep-sumene)/aincr
6207 write (2,*) "zz+ sumene from enesc=",sumenep
6208 costsave=cost2tab(i+1)
6209 sintsave=sint2tab(i+1)
6210 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6211 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6212 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6213 de_dt_num=(sumenep-sumene)/aincr
6214 write (2,*) " t+ sumene from enesc=",sumenep
6215 cost2tab(i+1)=costsave
6216 sint2tab(i+1)=sintsave
6217 C End of diagnostics section.
6220 C Compute the gradient of esc
6222 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6223 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6224 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6225 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6226 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6227 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6228 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6229 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6230 pom1=(sumene3*sint2tab(i+1)+sumene1)
6231 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6232 pom2=(sumene4*cost2tab(i+1)+sumene2)
6233 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6234 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6235 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6236 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6238 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6239 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6240 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6242 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6243 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6244 & +(pom1+pom2)*pom_dx
6246 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
6249 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6250 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6251 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6253 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6254 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6255 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6256 & +x(59)*zz**2 +x(60)*xx*zz
6257 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6258 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6259 & +(pom1-pom2)*pom_dy
6261 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
6264 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6265 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6266 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6267 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6268 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6269 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6270 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6271 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6273 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
6276 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6277 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6278 & +pom1*pom_dt1+pom2*pom_dt2
6280 write(2,*), "de_dt = ", de_dt,de_dt_num
6284 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6285 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6286 cosfac2xx=cosfac2*xx
6287 sinfac2yy=sinfac2*yy
6289 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6291 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6293 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6294 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6295 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6296 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6297 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6298 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6299 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6300 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6301 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6302 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6306 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6307 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6308 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6309 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6312 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6313 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6314 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
6316 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6317 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6321 dXX_Ctab(k,i)=dXX_Ci(k)
6322 dXX_C1tab(k,i)=dXX_Ci1(k)
6323 dYY_Ctab(k,i)=dYY_Ci(k)
6324 dYY_C1tab(k,i)=dYY_Ci1(k)
6325 dZZ_Ctab(k,i)=dZZ_Ci(k)
6326 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6327 dXX_XYZtab(k,i)=dXX_XYZ(k)
6328 dYY_XYZtab(k,i)=dYY_XYZ(k)
6329 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6333 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6334 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6335 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6336 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6337 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6339 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6340 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6341 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6342 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6343 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6344 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6345 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6346 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6348 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6349 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6351 C to check gradient call subroutine check_grad
6358 c------------------------------------------------------------------------------
6359 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6361 C This procedure calculates two-body contact function g(rij) and its derivative:
6364 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6367 C where x=(rij-r0ij)/delta
6369 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6372 double precision rij,r0ij,eps0ij,fcont,fprimcont
6373 double precision x,x2,x4,delta
6377 if (x.lt.-1.0D0) then
6380 else if (x.le.1.0D0) then
6383 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6384 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6391 c------------------------------------------------------------------------------
6392 subroutine splinthet(theti,delta,ss,ssder)
6393 implicit real*8 (a-h,o-z)
6394 include 'DIMENSIONS'
6395 include 'DIMENSIONS.ZSCOPT'
6396 include 'COMMON.VAR'
6397 include 'COMMON.GEO'
6400 if (theti.gt.pipol) then
6401 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6403 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6408 c------------------------------------------------------------------------------
6409 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6411 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6412 double precision ksi,ksi2,ksi3,a1,a2,a3
6413 a1=fprim0*delta/(f1-f0)
6419 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6420 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6423 c------------------------------------------------------------------------------
6424 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6426 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6427 double precision ksi,ksi2,ksi3,a1,a2,a3
6432 a2=3*(f1x-f0x)-2*fprim0x*delta
6433 a3=fprim0x*delta-2*(f1x-f0x)
6434 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6437 C-----------------------------------------------------------------------------
6439 C-----------------------------------------------------------------------------
6440 subroutine etor(etors,fact)
6441 implicit real*8 (a-h,o-z)
6442 include 'DIMENSIONS'
6443 include 'DIMENSIONS.ZSCOPT'
6444 include 'COMMON.VAR'
6445 include 'COMMON.GEO'
6446 include 'COMMON.LOCAL'
6447 include 'COMMON.TORSION'
6448 include 'COMMON.INTERACT'
6449 include 'COMMON.DERIV'
6450 include 'COMMON.CHAIN'
6451 include 'COMMON.NAMES'
6452 include 'COMMON.IOUNITS'
6453 include 'COMMON.FFIELD'
6454 include 'COMMON.TORCNSTR'
6456 C Set lprn=.true. for debugging
6460 do i=iphi_start,iphi_end
6461 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6462 & .or. itype(i).eq.ntyp1) cycle
6463 itori=itortyp(itype(i-2))
6464 itori1=itortyp(itype(i-1))
6467 C Proline-Proline pair is a special case...
6468 if (itori.eq.3 .and. itori1.eq.3) then
6469 if (phii.gt.-dwapi3) then
6471 fac=1.0D0/(1.0D0-cosphi)
6472 etorsi=v1(1,3,3)*fac
6473 etorsi=etorsi+etorsi
6474 etors=etors+etorsi-v1(1,3,3)
6475 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6478 v1ij=v1(j+1,itori,itori1)
6479 v2ij=v2(j+1,itori,itori1)
6482 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6483 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6487 v1ij=v1(j,itori,itori1)
6488 v2ij=v2(j,itori,itori1)
6491 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6492 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6496 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6497 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6498 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6499 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6500 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6504 c------------------------------------------------------------------------------
6506 subroutine etor(etors,fact)
6507 implicit real*8 (a-h,o-z)
6508 include 'DIMENSIONS'
6509 include 'DIMENSIONS.ZSCOPT'
6510 include 'COMMON.VAR'
6511 include 'COMMON.GEO'
6512 include 'COMMON.LOCAL'
6513 include 'COMMON.TORSION'
6514 include 'COMMON.INTERACT'
6515 include 'COMMON.DERIV'
6516 include 'COMMON.CHAIN'
6517 include 'COMMON.NAMES'
6518 include 'COMMON.IOUNITS'
6519 include 'COMMON.FFIELD'
6520 include 'COMMON.TORCNSTR'
6522 C Set lprn=.true. for debugging
6526 do i=iphi_start,iphi_end
6528 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6529 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6530 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6531 C & .or. itype(i).eq.ntyp1) cycle
6532 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6533 if (iabs(itype(i)).eq.20) then
6538 itori=itortyp(itype(i-2))
6539 itori1=itortyp(itype(i-1))
6542 C Regular cosine and sine terms
6543 do j=1,nterm(itori,itori1,iblock)
6544 v1ij=v1(j,itori,itori1,iblock)
6545 v2ij=v2(j,itori,itori1,iblock)
6548 etors=etors+v1ij*cosphi+v2ij*sinphi
6549 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6553 C E = SUM ----------------------------------- - v1
6554 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6556 cosphi=dcos(0.5d0*phii)
6557 sinphi=dsin(0.5d0*phii)
6558 do j=1,nlor(itori,itori1,iblock)
6559 vl1ij=vlor1(j,itori,itori1)
6560 vl2ij=vlor2(j,itori,itori1)
6561 vl3ij=vlor3(j,itori,itori1)
6562 pom=vl2ij*cosphi+vl3ij*sinphi
6563 pom1=1.0d0/(pom*pom+1.0d0)
6564 etors=etors+vl1ij*pom1
6565 c if (energy_dec) etors_ii=etors_ii+
6568 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6570 C Subtract the constant term
6571 etors=etors-v0(itori,itori1,iblock)
6573 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6574 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6575 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
6576 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6577 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6582 c----------------------------------------------------------------------------
6583 subroutine etor_d(etors_d,fact2)
6584 C 6/23/01 Compute double torsional energy
6585 implicit real*8 (a-h,o-z)
6586 include 'DIMENSIONS'
6587 include 'DIMENSIONS.ZSCOPT'
6588 include 'COMMON.VAR'
6589 include 'COMMON.GEO'
6590 include 'COMMON.LOCAL'
6591 include 'COMMON.TORSION'
6592 include 'COMMON.INTERACT'
6593 include 'COMMON.DERIV'
6594 include 'COMMON.CHAIN'
6595 include 'COMMON.NAMES'
6596 include 'COMMON.IOUNITS'
6597 include 'COMMON.FFIELD'
6598 include 'COMMON.TORCNSTR'
6600 C Set lprn=.true. for debugging
6604 do i=iphi_start,iphi_end-1
6606 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6607 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
6608 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6609 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6610 & (itype(i+1).eq.ntyp1)) cycle
6611 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6613 itori=itortyp(itype(i-2))
6614 itori1=itortyp(itype(i-1))
6615 itori2=itortyp(itype(i))
6621 if (iabs(itype(i+1)).eq.20) iblock=2
6622 C Regular cosine and sine terms
6623 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6624 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6625 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6626 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6627 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6628 cosphi1=dcos(j*phii)
6629 sinphi1=dsin(j*phii)
6630 cosphi2=dcos(j*phii1)
6631 sinphi2=dsin(j*phii1)
6632 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6633 & v2cij*cosphi2+v2sij*sinphi2
6634 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6635 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6637 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6639 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6640 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6641 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6642 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6643 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6644 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6645 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6646 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6647 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6648 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6649 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6650 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6651 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6652 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6655 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6656 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6662 c---------------------------------------------------------------------------
6663 C The rigorous attempt to derive energy function
6664 subroutine etor_kcc(etors,fact)
6665 implicit real*8 (a-h,o-z)
6666 include 'DIMENSIONS'
6667 include 'DIMENSIONS.ZSCOPT'
6668 include 'COMMON.VAR'
6669 include 'COMMON.GEO'
6670 include 'COMMON.LOCAL'
6671 include 'COMMON.TORSION'
6672 include 'COMMON.INTERACT'
6673 include 'COMMON.DERIV'
6674 include 'COMMON.CHAIN'
6675 include 'COMMON.NAMES'
6676 include 'COMMON.IOUNITS'
6677 include 'COMMON.FFIELD'
6678 include 'COMMON.TORCNSTR'
6679 include 'COMMON.CONTROL'
6680 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
6682 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
6683 C Set lprn=.true. for debugging
6686 C print *,"wchodze kcc"
6687 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
6689 do i=iphi_start,iphi_end
6690 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6691 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6692 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6693 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6694 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6695 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6696 itori=itortyp(itype(i-2))
6697 itori1=itortyp(itype(i-1))
6702 C to avoid multiple devision by 2
6703 c theti22=0.5d0*theta(i)
6704 C theta 12 is the theta_1 /2
6705 C theta 22 is theta_2 /2
6706 c theti12=0.5d0*theta(i-1)
6707 C and appropriate sinus function
6708 sinthet1=dsin(theta(i-1))
6709 sinthet2=dsin(theta(i))
6710 costhet1=dcos(theta(i-1))
6711 costhet2=dcos(theta(i))
6712 C to speed up lets store its mutliplication
6713 sint1t2=sinthet2*sinthet1
6715 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
6716 C +d_n*sin(n*gamma)) *
6717 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
6718 C we have two sum 1) Non-Chebyshev which is with n and gamma
6719 nval=nterm_kcc_Tb(itori,itori1)
6725 c1(j)=c1(j-1)*costhet1
6726 c2(j)=c2(j-1)*costhet2
6729 do j=1,nterm_kcc(itori,itori1)
6733 sint1t2n=sint1t2n*sint1t2
6739 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6740 gradvalct1=gradvalct1+
6741 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6742 gradvalct2=gradvalct2+
6743 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6746 gradvalct1=-gradvalct1*sinthet1
6747 gradvalct2=-gradvalct2*sinthet2
6753 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6754 gradvalst1=gradvalst1+
6755 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6756 gradvalst2=gradvalst2+
6757 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6760 gradvalst1=-gradvalst1*sinthet1
6761 gradvalst2=-gradvalst2*sinthet2
6762 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6763 C glocig is the gradient local i site in gamma
6764 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6765 C now gradient over theta_1
6766 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6767 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6768 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6769 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6772 C derivative over gamma
6773 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6774 C derivative over theta1
6775 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6776 C now derivative over theta2
6777 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6779 write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6780 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6781 write (iout,*) "c1",(c1(k),k=0,nval),
6782 & " c2",(c2(k),k=0,nval)
6783 write (iout,*) "sumvalc",sumvalc," sumvals",sumvals
6788 c---------------------------------------------------------------------------------------------
6789 subroutine etor_constr(edihcnstr)
6790 implicit real*8 (a-h,o-z)
6791 include 'DIMENSIONS'
6792 include 'DIMENSIONS.ZSCOPT'
6793 include 'COMMON.VAR'
6794 include 'COMMON.GEO'
6795 include 'COMMON.LOCAL'
6796 include 'COMMON.TORSION'
6797 include 'COMMON.INTERACT'
6798 include 'COMMON.DERIV'
6799 include 'COMMON.CHAIN'
6800 include 'COMMON.NAMES'
6801 include 'COMMON.IOUNITS'
6802 include 'COMMON.FFIELD'
6803 include 'COMMON.TORCNSTR'
6804 include 'COMMON.CONTROL'
6805 ! 6/20/98 - dihedral angle constraints
6807 c do i=1,ndih_constr
6808 c write (iout,*) "idihconstr_start",idihconstr_start,
6809 c & " idihconstr_end",idihconstr_end
6811 if (raw_psipred) then
6812 do i=idihconstr_start,idihconstr_end
6813 itori=idih_constr(i)
6815 gaudih_i=vpsipred(1,i)
6819 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6820 dexpcos_i=dexp(-cos_i*cos_i)
6821 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6822 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6823 & *cos_i*dexpcos_i/s**2
6825 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6826 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6828 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6829 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6830 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6831 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6832 & -wdihc*dlog(gaudih_i)
6836 do i=idihconstr_start,idihconstr_end
6837 itori=idih_constr(i)
6839 difi=pinorm(phii-phi0(i))
6840 if (difi.gt.drange(i)) then
6842 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6843 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6844 else if (difi.lt.-drange(i)) then
6846 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6847 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6855 c write (iout,*) "ETOR_CONSTR",edihcnstr
6858 c----------------------------------------------------------------------------
6859 C The rigorous attempt to derive energy function
6860 subroutine ebend_kcc(etheta)
6862 implicit real*8 (a-h,o-z)
6863 include 'DIMENSIONS'
6864 include 'DIMENSIONS.ZSCOPT'
6865 include 'COMMON.VAR'
6866 include 'COMMON.GEO'
6867 include 'COMMON.LOCAL'
6868 include 'COMMON.TORSION'
6869 include 'COMMON.INTERACT'
6870 include 'COMMON.DERIV'
6871 include 'COMMON.CHAIN'
6872 include 'COMMON.NAMES'
6873 include 'COMMON.IOUNITS'
6874 include 'COMMON.FFIELD'
6875 include 'COMMON.TORCNSTR'
6876 include 'COMMON.CONTROL'
6878 double precision thybt1(maxang_kcc)
6879 C Set lprn=.true. for debugging
6882 C print *,"wchodze kcc"
6883 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6885 do i=ithet_start,ithet_end
6886 c print *,i,itype(i-1),itype(i),itype(i-2)
6887 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6888 & .or.itype(i).eq.ntyp1) cycle
6889 iti=iabs(itortyp(itype(i-1)))
6890 sinthet=dsin(theta(i))
6891 costhet=dcos(theta(i))
6892 do j=1,nbend_kcc_Tb(iti)
6893 thybt1(j)=v1bend_chyb(j,iti)
6895 sumth1thyb=v1bend_chyb(0,iti)+
6896 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6897 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6899 ihelp=nbend_kcc_Tb(iti)-1
6900 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6901 etheta=etheta+sumth1thyb
6902 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6903 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6907 c-------------------------------------------------------------------------------------
6908 subroutine etheta_constr(ethetacnstr)
6910 implicit real*8 (a-h,o-z)
6911 include 'DIMENSIONS'
6912 include 'DIMENSIONS.ZSCOPT'
6913 include 'COMMON.VAR'
6914 include 'COMMON.GEO'
6915 include 'COMMON.LOCAL'
6916 include 'COMMON.TORSION'
6917 include 'COMMON.INTERACT'
6918 include 'COMMON.DERIV'
6919 include 'COMMON.CHAIN'
6920 include 'COMMON.NAMES'
6921 include 'COMMON.IOUNITS'
6922 include 'COMMON.FFIELD'
6923 include 'COMMON.TORCNSTR'
6924 include 'COMMON.CONTROL'
6926 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6927 do i=ithetaconstr_start,ithetaconstr_end
6928 itheta=itheta_constr(i)
6929 thetiii=theta(itheta)
6930 difi=pinorm(thetiii-theta_constr0(i))
6931 if (difi.gt.theta_drange(i)) then
6932 difi=difi-theta_drange(i)
6933 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6934 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6935 & +for_thet_constr(i)*difi**3
6936 else if (difi.lt.-drange(i)) then
6938 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6939 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6940 & +for_thet_constr(i)*difi**3
6944 if (energy_dec) then
6945 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6946 & i,itheta,rad2deg*thetiii,
6947 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6948 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6949 & gloc(itheta+nphi-2,icg)
6954 c------------------------------------------------------------------------------
6955 c------------------------------------------------------------------------------
6956 subroutine eback_sc_corr(esccor)
6957 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6958 c conformational states; temporarily implemented as differences
6959 c between UNRES torsional potentials (dependent on three types of
6960 c residues) and the torsional potentials dependent on all 20 types
6961 c of residues computed from AM1 energy surfaces of terminally-blocked
6962 c amino-acid residues.
6963 implicit real*8 (a-h,o-z)
6964 include 'DIMENSIONS'
6965 include 'DIMENSIONS.ZSCOPT'
6966 include 'COMMON.VAR'
6967 include 'COMMON.GEO'
6968 include 'COMMON.LOCAL'
6969 include 'COMMON.TORSION'
6970 include 'COMMON.SCCOR'
6971 include 'COMMON.INTERACT'
6972 include 'COMMON.DERIV'
6973 include 'COMMON.CHAIN'
6974 include 'COMMON.NAMES'
6975 include 'COMMON.IOUNITS'
6976 include 'COMMON.FFIELD'
6977 include 'COMMON.CONTROL'
6979 C Set lprn=.true. for debugging
6982 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6984 do i=itau_start,itau_end
6985 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6987 isccori=isccortyp(itype(i-2))
6988 isccori1=isccortyp(itype(i-1))
6990 do intertyp=1,3 !intertyp
6991 cc Added 09 May 2012 (Adasko)
6992 cc Intertyp means interaction type of backbone mainchain correlation:
6993 c 1 = SC...Ca...Ca...Ca
6994 c 2 = Ca...Ca...Ca...SC
6995 c 3 = SC...Ca...Ca...SCi
6997 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6998 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6999 & (itype(i-1).eq.ntyp1)))
7000 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7001 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7002 & .or.(itype(i).eq.ntyp1)))
7003 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7004 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7005 & (itype(i-3).eq.ntyp1)))) cycle
7006 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7007 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7009 do j=1,nterm_sccor(isccori,isccori1)
7010 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7011 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7012 cosphi=dcos(j*tauangle(intertyp,i))
7013 sinphi=dsin(j*tauangle(intertyp,i))
7014 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7015 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7017 C write (iout,*)"EBACK_SC_COR",esccor,i
7018 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
7019 c & nterm_sccor(isccori,isccori1),isccori,isccori1
7020 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7022 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7023 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7024 & (v1sccor(j,1,itori,itori1),j=1,6)
7025 & ,(v2sccor(j,1,itori,itori1),j=1,6)
7026 c gsccor_loc(i-3)=gloci
7032 c------------------------------------------------------------------------------
7033 subroutine multibody(ecorr)
7034 C This subroutine calculates multi-body contributions to energy following
7035 C the idea of Skolnick et al. If side chains I and J make a contact and
7036 C at the same time side chains I+1 and J+1 make a contact, an extra
7037 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7038 implicit real*8 (a-h,o-z)
7039 include 'DIMENSIONS'
7040 include 'COMMON.IOUNITS'
7041 include 'COMMON.DERIV'
7042 include 'COMMON.INTERACT'
7043 include 'COMMON.CONTACTS'
7044 include 'COMMON.CONTMAT'
7045 include 'COMMON.CORRMAT'
7046 double precision gx(3),gx1(3)
7049 C Set lprn=.true. for debugging
7053 write (iout,'(a)') 'Contact function values:'
7055 write (iout,'(i2,20(1x,i2,f10.5))')
7056 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7071 num_conti=num_cont(i)
7072 num_conti1=num_cont(i1)
7077 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7078 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7079 cd & ' ishift=',ishift
7080 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7081 C The system gains extra energy.
7082 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7083 endif ! j1==j+-ishift
7092 c------------------------------------------------------------------------------
7093 double precision function esccorr(i,j,k,l,jj,kk)
7094 implicit real*8 (a-h,o-z)
7095 include 'DIMENSIONS'
7096 include 'COMMON.IOUNITS'
7097 include 'COMMON.DERIV'
7098 include 'COMMON.INTERACT'
7099 include 'COMMON.CONTACTS'
7100 include 'COMMON.CONTMAT'
7101 include 'COMMON.CORRMAT'
7102 double precision gx(3),gx1(3)
7107 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7108 C Calculate the multi-body contribution to energy.
7109 C Calculate multi-body contributions to the gradient.
7110 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7111 cd & k,l,(gacont(m,kk,k),m=1,3)
7113 gx(m) =ekl*gacont(m,jj,i)
7114 gx1(m)=eij*gacont(m,kk,k)
7115 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7116 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7117 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7118 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7122 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7127 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7133 c------------------------------------------------------------------------------
7134 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7135 C This subroutine calculates multi-body contributions to hydrogen-bonding
7136 implicit real*8 (a-h,o-z)
7137 include 'DIMENSIONS'
7138 include 'DIMENSIONS.ZSCOPT'
7139 include 'COMMON.IOUNITS'
7140 include 'COMMON.FFIELD'
7141 include 'COMMON.DERIV'
7142 include 'COMMON.INTERACT'
7143 include 'COMMON.CONTACTS'
7144 include 'COMMON.CONTMAT'
7145 include 'COMMON.CORRMAT'
7146 double precision gx(3),gx1(3)
7149 C Set lprn=.true. for debugging
7152 write (iout,'(a)') 'Contact function values:'
7154 write (iout,'(2i3,50(1x,i2,f5.2))')
7155 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7156 & j=1,num_cont_hb(i))
7160 C Remove the loop below after debugging !!!
7167 C Calculate the local-electrostatic correlation terms
7168 do i=iatel_s,iatel_e+1
7170 num_conti=num_cont_hb(i)
7171 num_conti1=num_cont_hb(i+1)
7176 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7177 c & ' jj=',jj,' kk=',kk
7178 if (j1.eq.j+1 .or. j1.eq.j-1) then
7179 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7180 C The system gains extra energy.
7181 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7183 else if (j1.eq.j) then
7184 C Contacts I-J and I-(J+1) occur simultaneously.
7185 C The system loses extra energy.
7186 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7191 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7192 c & ' jj=',jj,' kk=',kk
7194 C Contacts I-J and (I+1)-J occur simultaneously.
7195 C The system loses extra energy.
7196 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7203 c------------------------------------------------------------------------------
7204 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7206 C This subroutine calculates multi-body contributions to hydrogen-bonding
7207 implicit real*8 (a-h,o-z)
7208 include 'DIMENSIONS'
7209 include 'DIMENSIONS.ZSCOPT'
7210 include 'COMMON.IOUNITS'
7214 include 'COMMON.FFIELD'
7215 include 'COMMON.DERIV'
7216 include 'COMMON.LOCAL'
7217 include 'COMMON.INTERACT'
7218 include 'COMMON.CONTACTS'
7219 include 'COMMON.CONTMAT'
7220 include 'COMMON.CORRMAT'
7221 include 'COMMON.CHAIN'
7222 include 'COMMON.CONTROL'
7223 include 'COMMON.SHIELD'
7224 double precision gx(3),gx1(3)
7225 integer num_cont_hb_old(maxres)
7227 double precision eello4,eello5,eelo6,eello_turn6
7228 external eello4,eello5,eello6,eello_turn6
7229 C Set lprn=.true. for debugging
7233 write (iout,'(a)') 'Contact function values:'
7235 write (iout,'(2i3,50(1x,i2,5f6.3))')
7236 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7237 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7243 C Remove the loop below after debugging !!!
7250 C Calculate the dipole-dipole interaction energies
7251 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7252 do i=iatel_s,iatel_e+1
7253 num_conti=num_cont_hb(i)
7262 C Calculate the local-electrostatic correlation terms
7263 c write (iout,*) "gradcorr5 in eello5 before loop"
7265 c write (iout,'(i5,3f10.5)')
7266 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7268 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7269 c write (iout,*) "corr loop i",i
7271 num_conti=num_cont_hb(i)
7272 num_conti1=num_cont_hb(i+1)
7279 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7280 c & ' jj=',jj,' kk=',kk
7281 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7282 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7283 & .or. j.lt.0 .and. j1.gt.0) .and.
7284 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7285 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7286 C The system gains extra energy.
7288 sqd1=dsqrt(d_cont(jj,i))
7289 sqd2=dsqrt(d_cont(kk,i1))
7290 sred_geom = sqd1*sqd2
7291 IF (sred_geom.lt.cutoff_corr) THEN
7292 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7294 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7295 cd & ' jj=',jj,' kk=',kk
7296 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7297 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7299 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7300 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7303 cd write (iout,*) 'sred_geom=',sred_geom,
7304 cd & ' ekont=',ekont,' fprim=',fprimcont,
7305 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7306 cd write (iout,*) "g_contij",g_contij
7307 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7308 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7309 call calc_eello(i,jp,i+1,jp1,jj,kk)
7310 if (wcorr4.gt.0.0d0)
7311 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7312 CC & *fac_shield(i)**2*fac_shield(j)**2
7313 if (energy_dec.and.wcorr4.gt.0.0d0)
7314 1 write (iout,'(a6,4i5,0pf7.3)')
7315 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7316 c write (iout,*) "gradcorr5 before eello5"
7318 c write (iout,'(i5,3f10.5)')
7319 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7321 if (wcorr5.gt.0.0d0)
7322 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7323 c write (iout,*) "gradcorr5 after eello5"
7325 c write (iout,'(i5,3f10.5)')
7326 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7328 if (energy_dec.and.wcorr5.gt.0.0d0)
7329 1 write (iout,'(a6,4i5,0pf7.3)')
7330 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7331 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7332 cd write(2,*)'ijkl',i,jp,i+1,jp1
7333 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7334 & .or. wturn6.eq.0.0d0))then
7335 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7336 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7337 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7338 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7339 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7340 cd & 'ecorr6=',ecorr6
7341 cd write (iout,'(4e15.5)') sred_geom,
7342 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7343 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7344 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7345 else if (wturn6.gt.0.0d0
7346 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7347 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7348 eturn6=eturn6+eello_turn6(i,jj,kk)
7349 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7350 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7351 cd write (2,*) 'multibody_eello:eturn6',eturn6
7360 num_cont_hb(i)=num_cont_hb_old(i)
7362 c write (iout,*) "gradcorr5 in eello5"
7364 c write (iout,'(i5,3f10.5)')
7365 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7369 c------------------------------------------------------------------------------
7370 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7371 implicit real*8 (a-h,o-z)
7372 include 'DIMENSIONS'
7373 include 'DIMENSIONS.ZSCOPT'
7374 include 'COMMON.IOUNITS'
7375 include 'COMMON.DERIV'
7376 include 'COMMON.INTERACT'
7377 include 'COMMON.CONTACTS'
7378 include 'COMMON.CONTMAT'
7379 include 'COMMON.CORRMAT'
7380 include 'COMMON.SHIELD'
7381 include 'COMMON.CONTROL'
7382 double precision gx(3),gx1(3)
7385 C print *,"wchodze",fac_shield(i),shield_mode
7393 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7395 C & fac_shield(i)**2*fac_shield(j)**2
7396 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7397 C Following 4 lines for diagnostics.
7402 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7403 c & 'Contacts ',i,j,
7404 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7405 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7407 C Calculate the multi-body contribution to energy.
7408 C ecorr=ecorr+ekont*ees
7409 C Calculate multi-body contributions to the gradient.
7410 coeffpees0pij=coeffp*ees0pij
7411 coeffmees0mij=coeffm*ees0mij
7412 coeffpees0pkl=coeffp*ees0pkl
7413 coeffmees0mkl=coeffm*ees0mkl
7415 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7416 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7417 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7418 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7419 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7420 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7421 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7422 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7423 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7424 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7425 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7426 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7427 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7428 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7429 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7430 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7431 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7432 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7433 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7434 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7435 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7436 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7437 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7438 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7439 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7444 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7445 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7446 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7447 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7452 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7453 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7454 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7455 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7458 c write (iout,*) "ehbcorr",ekont*ees
7459 C print *,ekont,ees,i,k
7461 C now gradient over shielding
7463 if (shield_mode.gt.0) then
7466 C print *,i,j,fac_shield(i),fac_shield(j),
7467 C &fac_shield(k),fac_shield(l)
7468 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
7469 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7470 do ilist=1,ishield_list(i)
7471 iresshield=shield_list(ilist,i)
7473 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7475 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7477 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7478 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7482 do ilist=1,ishield_list(j)
7483 iresshield=shield_list(ilist,j)
7485 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7487 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7489 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7490 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7495 do ilist=1,ishield_list(k)
7496 iresshield=shield_list(ilist,k)
7498 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7500 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7502 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7503 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7507 do ilist=1,ishield_list(l)
7508 iresshield=shield_list(ilist,l)
7510 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7512 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7514 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7515 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7519 C print *,gshieldx(m,iresshield)
7521 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
7522 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7523 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
7524 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7525 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
7526 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7527 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
7528 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7530 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
7531 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7532 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
7533 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7534 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
7535 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7536 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
7537 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7545 C---------------------------------------------------------------------------
7546 subroutine dipole(i,j,jj)
7547 implicit real*8 (a-h,o-z)
7548 include 'DIMENSIONS'
7549 include 'DIMENSIONS.ZSCOPT'
7550 include 'COMMON.IOUNITS'
7551 include 'COMMON.CHAIN'
7552 include 'COMMON.FFIELD'
7553 include 'COMMON.DERIV'
7554 include 'COMMON.INTERACT'
7555 include 'COMMON.CONTACTS'
7556 include 'COMMON.CONTMAT'
7557 include 'COMMON.CORRMAT'
7558 include 'COMMON.TORSION'
7559 include 'COMMON.VAR'
7560 include 'COMMON.GEO'
7561 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7563 iti1 = itortyp(itype(i+1))
7564 if (j.lt.nres-1) then
7565 itj1 = itype2loc(itype(j+1))
7570 dipi(iii,1)=Ub2(iii,i)
7571 dipderi(iii)=Ub2der(iii,i)
7572 dipi(iii,2)=b1(iii,i+1)
7573 dipj(iii,1)=Ub2(iii,j)
7574 dipderj(iii)=Ub2der(iii,j)
7575 dipj(iii,2)=b1(iii,j+1)
7579 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7582 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7589 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7593 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7598 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7599 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7601 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7603 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7605 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7610 C---------------------------------------------------------------------------
7611 subroutine calc_eello(i,j,k,l,jj,kk)
7613 C This subroutine computes matrices and vectors needed to calculate
7614 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7616 implicit real*8 (a-h,o-z)
7617 include 'DIMENSIONS'
7618 include 'DIMENSIONS.ZSCOPT'
7619 include 'COMMON.IOUNITS'
7620 include 'COMMON.CHAIN'
7621 include 'COMMON.DERIV'
7622 include 'COMMON.INTERACT'
7623 include 'COMMON.CONTACTS'
7624 include 'COMMON.CONTMAT'
7625 include 'COMMON.CORRMAT'
7626 include 'COMMON.TORSION'
7627 include 'COMMON.VAR'
7628 include 'COMMON.GEO'
7629 include 'COMMON.FFIELD'
7630 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7631 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7634 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7635 cd & ' jj=',jj,' kk=',kk
7636 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7637 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7638 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7641 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7642 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7645 call transpose2(aa1(1,1),aa1t(1,1))
7646 call transpose2(aa2(1,1),aa2t(1,1))
7649 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7650 & aa1tder(1,1,lll,kkk))
7651 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7652 & aa2tder(1,1,lll,kkk))
7656 C parallel orientation of the two CA-CA-CA frames.
7658 iti=itype2loc(itype(i))
7662 itk1=itype2loc(itype(k+1))
7663 itj=itype2loc(itype(j))
7664 if (l.lt.nres-1) then
7665 itl1=itype2loc(itype(l+1))
7669 C A1 kernel(j+1) A2T
7671 cd write (iout,'(3f10.5,5x,3f10.5)')
7672 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7674 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7675 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7676 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7677 C Following matrices are needed only for 6-th order cumulants
7678 IF (wcorr6.gt.0.0d0) THEN
7679 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7680 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7681 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7682 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7683 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7684 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7685 & ADtEAderx(1,1,1,1,1,1))
7687 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7688 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7689 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7690 & ADtEA1derx(1,1,1,1,1,1))
7692 C End 6-th order cumulants
7695 cd write (2,*) 'In calc_eello6'
7697 cd write (2,*) 'iii=',iii
7699 cd write (2,*) 'kkk=',kkk
7701 cd write (2,'(3(2f10.5),5x)')
7702 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7707 call transpose2(EUgder(1,1,k),auxmat(1,1))
7708 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7709 call transpose2(EUg(1,1,k),auxmat(1,1))
7710 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7711 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7715 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7716 & EAEAderx(1,1,lll,kkk,iii,1))
7720 C A1T kernel(i+1) A2
7721 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7722 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7723 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7724 C Following matrices are needed only for 6-th order cumulants
7725 IF (wcorr6.gt.0.0d0) THEN
7726 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7727 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7728 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7729 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7730 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7731 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7732 & ADtEAderx(1,1,1,1,1,2))
7733 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7734 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7735 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7736 & ADtEA1derx(1,1,1,1,1,2))
7738 C End 6-th order cumulants
7739 call transpose2(EUgder(1,1,l),auxmat(1,1))
7740 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7741 call transpose2(EUg(1,1,l),auxmat(1,1))
7742 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7743 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7747 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7748 & EAEAderx(1,1,lll,kkk,iii,2))
7753 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7754 C They are needed only when the fifth- or the sixth-order cumulants are
7756 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7757 call transpose2(AEA(1,1,1),auxmat(1,1))
7758 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7759 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7760 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7761 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7762 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7763 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7764 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7765 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7766 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7767 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7768 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7769 call transpose2(AEA(1,1,2),auxmat(1,1))
7770 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7771 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7772 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7773 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7774 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7775 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7776 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7777 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7778 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7779 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7780 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7781 C Calculate the Cartesian derivatives of the vectors.
7785 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7786 call matvec2(auxmat(1,1),b1(1,i),
7787 & AEAb1derx(1,lll,kkk,iii,1,1))
7788 call matvec2(auxmat(1,1),Ub2(1,i),
7789 & AEAb2derx(1,lll,kkk,iii,1,1))
7790 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7791 & AEAb1derx(1,lll,kkk,iii,2,1))
7792 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7793 & AEAb2derx(1,lll,kkk,iii,2,1))
7794 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7795 call matvec2(auxmat(1,1),b1(1,j),
7796 & AEAb1derx(1,lll,kkk,iii,1,2))
7797 call matvec2(auxmat(1,1),Ub2(1,j),
7798 & AEAb2derx(1,lll,kkk,iii,1,2))
7799 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7800 & AEAb1derx(1,lll,kkk,iii,2,2))
7801 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7802 & AEAb2derx(1,lll,kkk,iii,2,2))
7809 C Antiparallel orientation of the two CA-CA-CA frames.
7811 iti=itype2loc(itype(i))
7815 itk1=itype2loc(itype(k+1))
7816 itl=itype2loc(itype(l))
7817 itj=itype2loc(itype(j))
7818 if (j.lt.nres-1) then
7819 itj1=itype2loc(itype(j+1))
7823 C A2 kernel(j-1)T A1T
7824 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7825 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7826 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7827 C Following matrices are needed only for 6-th order cumulants
7828 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7829 & j.eq.i+4 .and. l.eq.i+3)) THEN
7830 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7831 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7832 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7833 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7834 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7835 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7836 & ADtEAderx(1,1,1,1,1,1))
7837 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7838 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7839 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7840 & ADtEA1derx(1,1,1,1,1,1))
7842 C End 6-th order cumulants
7843 call transpose2(EUgder(1,1,k),auxmat(1,1))
7844 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7845 call transpose2(EUg(1,1,k),auxmat(1,1))
7846 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7847 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7851 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7852 & EAEAderx(1,1,lll,kkk,iii,1))
7856 C A2T kernel(i+1)T A1
7857 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7858 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7859 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7860 C Following matrices are needed only for 6-th order cumulants
7861 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7862 & j.eq.i+4 .and. l.eq.i+3)) THEN
7863 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7864 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7865 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7866 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7867 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7868 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7869 & ADtEAderx(1,1,1,1,1,2))
7870 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7871 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7872 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7873 & ADtEA1derx(1,1,1,1,1,2))
7875 C End 6-th order cumulants
7876 call transpose2(EUgder(1,1,j),auxmat(1,1))
7877 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7878 call transpose2(EUg(1,1,j),auxmat(1,1))
7879 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7880 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7884 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7885 & EAEAderx(1,1,lll,kkk,iii,2))
7890 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7891 C They are needed only when the fifth- or the sixth-order cumulants are
7893 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7894 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7895 call transpose2(AEA(1,1,1),auxmat(1,1))
7896 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7897 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7898 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7899 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7900 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7901 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7902 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7903 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7904 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7905 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7906 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7907 call transpose2(AEA(1,1,2),auxmat(1,1))
7908 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7909 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7910 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7911 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7912 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7913 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7914 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7915 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7916 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7917 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7918 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7919 C Calculate the Cartesian derivatives of the vectors.
7923 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7924 call matvec2(auxmat(1,1),b1(1,i),
7925 & AEAb1derx(1,lll,kkk,iii,1,1))
7926 call matvec2(auxmat(1,1),Ub2(1,i),
7927 & AEAb2derx(1,lll,kkk,iii,1,1))
7928 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7929 & AEAb1derx(1,lll,kkk,iii,2,1))
7930 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7931 & AEAb2derx(1,lll,kkk,iii,2,1))
7932 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7933 call matvec2(auxmat(1,1),b1(1,l),
7934 & AEAb1derx(1,lll,kkk,iii,1,2))
7935 call matvec2(auxmat(1,1),Ub2(1,l),
7936 & AEAb2derx(1,lll,kkk,iii,1,2))
7937 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7938 & AEAb1derx(1,lll,kkk,iii,2,2))
7939 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7940 & AEAb2derx(1,lll,kkk,iii,2,2))
7949 C---------------------------------------------------------------------------
7950 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7951 & KK,KKderg,AKA,AKAderg,AKAderx)
7955 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7956 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7957 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7962 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7964 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7967 cd if (lprn) write (2,*) 'In kernel'
7969 cd if (lprn) write (2,*) 'kkk=',kkk
7971 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7972 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7974 cd write (2,*) 'lll=',lll
7975 cd write (2,*) 'iii=1'
7977 cd write (2,'(3(2f10.5),5x)')
7978 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7981 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7982 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7984 cd write (2,*) 'lll=',lll
7985 cd write (2,*) 'iii=2'
7987 cd write (2,'(3(2f10.5),5x)')
7988 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7995 C---------------------------------------------------------------------------
7996 double precision function eello4(i,j,k,l,jj,kk)
7997 implicit real*8 (a-h,o-z)
7998 include 'DIMENSIONS'
7999 include 'DIMENSIONS.ZSCOPT'
8000 include 'COMMON.IOUNITS'
8001 include 'COMMON.CHAIN'
8002 include 'COMMON.DERIV'
8003 include 'COMMON.INTERACT'
8004 include 'COMMON.CONTACTS'
8005 include 'COMMON.CONTMAT'
8006 include 'COMMON.CORRMAT'
8007 include 'COMMON.TORSION'
8008 include 'COMMON.VAR'
8009 include 'COMMON.GEO'
8010 double precision pizda(2,2),ggg1(3),ggg2(3)
8011 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8015 cd print *,'eello4:',i,j,k,l,jj,kk
8016 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8017 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8018 cold eij=facont_hb(jj,i)
8019 cold ekl=facont_hb(kk,k)
8021 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8023 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8024 gcorr_loc(k-1)=gcorr_loc(k-1)
8025 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8027 gcorr_loc(l-1)=gcorr_loc(l-1)
8028 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8030 gcorr_loc(j-1)=gcorr_loc(j-1)
8031 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8036 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8037 & -EAEAderx(2,2,lll,kkk,iii,1)
8038 cd derx(lll,kkk,iii)=0.0d0
8042 cd gcorr_loc(l-1)=0.0d0
8043 cd gcorr_loc(j-1)=0.0d0
8044 cd gcorr_loc(k-1)=0.0d0
8046 cd write (iout,*)'Contacts have occurred for peptide groups',
8047 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8048 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8049 if (j.lt.nres-1) then
8056 if (l.lt.nres-1) then
8064 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8065 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8066 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8067 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8068 cgrad ghalf=0.5d0*ggg1(ll)
8069 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8070 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8071 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8072 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8073 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8074 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8075 cgrad ghalf=0.5d0*ggg2(ll)
8076 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8077 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8078 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8079 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8080 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8081 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8085 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8090 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8095 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8100 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8104 cd write (2,*) iii,gcorr_loc(iii)
8108 cd write (2,*) 'ekont',ekont
8109 cd write (iout,*) 'eello4',ekont*eel4
8112 C---------------------------------------------------------------------------
8113 double precision function eello5(i,j,k,l,jj,kk)
8114 implicit real*8 (a-h,o-z)
8115 include 'DIMENSIONS'
8116 include 'DIMENSIONS.ZSCOPT'
8117 include 'COMMON.IOUNITS'
8118 include 'COMMON.CHAIN'
8119 include 'COMMON.DERIV'
8120 include 'COMMON.INTERACT'
8121 include 'COMMON.CONTACTS'
8122 include 'COMMON.CONTMAT'
8123 include 'COMMON.CORRMAT'
8124 include 'COMMON.TORSION'
8125 include 'COMMON.VAR'
8126 include 'COMMON.GEO'
8127 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8128 double precision ggg1(3),ggg2(3)
8129 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8134 C /l\ / \ \ / \ / \ / C
8135 C / \ / \ \ / \ / \ / C
8136 C j| o |l1 | o | o| o | | o |o C
8137 C \ |/k\| |/ \| / |/ \| |/ \| C
8138 C \i/ \ / \ / / \ / \ C
8140 C (I) (II) (III) (IV) C
8142 C eello5_1 eello5_2 eello5_3 eello5_4 C
8144 C Antiparallel chains C
8147 C /j\ / \ \ / \ / \ / C
8148 C / \ / \ \ / \ / \ / C
8149 C j1| o |l | o | o| o | | o |o C
8150 C \ |/k\| |/ \| / |/ \| |/ \| C
8151 C \i/ \ / \ / / \ / \ C
8153 C (I) (II) (III) (IV) C
8155 C eello5_1 eello5_2 eello5_3 eello5_4 C
8157 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8159 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8160 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8165 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8167 itk=itype2loc(itype(k))
8168 itl=itype2loc(itype(l))
8169 itj=itype2loc(itype(j))
8174 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8175 cd & eel5_3_num,eel5_4_num)
8179 derx(lll,kkk,iii)=0.0d0
8183 cd eij=facont_hb(jj,i)
8184 cd ekl=facont_hb(kk,k)
8186 cd write (iout,*)'Contacts have occurred for peptide groups',
8187 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8189 C Contribution from the graph I.
8190 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8191 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8192 call transpose2(EUg(1,1,k),auxmat(1,1))
8193 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8194 vv(1)=pizda(1,1)-pizda(2,2)
8195 vv(2)=pizda(1,2)+pizda(2,1)
8196 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8197 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8199 C Explicit gradient in virtual-dihedral angles.
8200 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8201 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8202 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8203 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8204 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8205 vv(1)=pizda(1,1)-pizda(2,2)
8206 vv(2)=pizda(1,2)+pizda(2,1)
8207 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8208 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8209 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8210 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8211 vv(1)=pizda(1,1)-pizda(2,2)
8212 vv(2)=pizda(1,2)+pizda(2,1)
8214 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8215 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8216 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8218 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8219 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8220 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8222 C Cartesian gradient
8226 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8228 vv(1)=pizda(1,1)-pizda(2,2)
8229 vv(2)=pizda(1,2)+pizda(2,1)
8230 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8231 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8232 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8239 C Contribution from graph II
8240 call transpose2(EE(1,1,k),auxmat(1,1))
8241 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8242 vv(1)=pizda(1,1)+pizda(2,2)
8243 vv(2)=pizda(2,1)-pizda(1,2)
8244 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8245 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8247 C Explicit gradient in virtual-dihedral angles.
8248 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8249 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8250 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8251 vv(1)=pizda(1,1)+pizda(2,2)
8252 vv(2)=pizda(2,1)-pizda(1,2)
8254 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8255 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8256 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8258 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8259 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8260 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8262 C Cartesian gradient
8266 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8268 vv(1)=pizda(1,1)+pizda(2,2)
8269 vv(2)=pizda(2,1)-pizda(1,2)
8270 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8271 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8272 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8281 C Parallel orientation
8282 C Contribution from graph III
8283 call transpose2(EUg(1,1,l),auxmat(1,1))
8284 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8285 vv(1)=pizda(1,1)-pizda(2,2)
8286 vv(2)=pizda(1,2)+pizda(2,1)
8287 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8288 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8290 C Explicit gradient in virtual-dihedral angles.
8291 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8292 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8293 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8294 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8295 vv(1)=pizda(1,1)-pizda(2,2)
8296 vv(2)=pizda(1,2)+pizda(2,1)
8297 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8298 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8299 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8300 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8301 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8302 vv(1)=pizda(1,1)-pizda(2,2)
8303 vv(2)=pizda(1,2)+pizda(2,1)
8304 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8305 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8306 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8307 C Cartesian gradient
8311 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8313 vv(1)=pizda(1,1)-pizda(2,2)
8314 vv(2)=pizda(1,2)+pizda(2,1)
8315 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8316 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8317 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8322 C Contribution from graph IV
8324 call transpose2(EE(1,1,l),auxmat(1,1))
8325 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8326 vv(1)=pizda(1,1)+pizda(2,2)
8327 vv(2)=pizda(2,1)-pizda(1,2)
8328 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8329 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8330 C Explicit gradient in virtual-dihedral angles.
8331 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8332 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8333 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8334 vv(1)=pizda(1,1)+pizda(2,2)
8335 vv(2)=pizda(2,1)-pizda(1,2)
8336 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8337 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8338 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8339 C Cartesian gradient
8343 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8345 vv(1)=pizda(1,1)+pizda(2,2)
8346 vv(2)=pizda(2,1)-pizda(1,2)
8347 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8348 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8349 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8355 C Antiparallel orientation
8356 C Contribution from graph III
8358 call transpose2(EUg(1,1,j),auxmat(1,1))
8359 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8360 vv(1)=pizda(1,1)-pizda(2,2)
8361 vv(2)=pizda(1,2)+pizda(2,1)
8362 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8363 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8365 C Explicit gradient in virtual-dihedral angles.
8366 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8367 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8368 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8369 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8370 vv(1)=pizda(1,1)-pizda(2,2)
8371 vv(2)=pizda(1,2)+pizda(2,1)
8372 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8373 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8374 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8375 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8376 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8377 vv(1)=pizda(1,1)-pizda(2,2)
8378 vv(2)=pizda(1,2)+pizda(2,1)
8379 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8380 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8381 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8382 C Cartesian gradient
8386 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8388 vv(1)=pizda(1,1)-pizda(2,2)
8389 vv(2)=pizda(1,2)+pizda(2,1)
8390 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8391 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8392 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8398 C Contribution from graph IV
8400 call transpose2(EE(1,1,j),auxmat(1,1))
8401 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8402 vv(1)=pizda(1,1)+pizda(2,2)
8403 vv(2)=pizda(2,1)-pizda(1,2)
8404 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8405 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8407 C Explicit gradient in virtual-dihedral angles.
8408 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8409 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8410 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8411 vv(1)=pizda(1,1)+pizda(2,2)
8412 vv(2)=pizda(2,1)-pizda(1,2)
8413 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8414 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8415 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8416 C Cartesian gradient
8420 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8422 vv(1)=pizda(1,1)+pizda(2,2)
8423 vv(2)=pizda(2,1)-pizda(1,2)
8424 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8425 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8426 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8433 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8434 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8435 cd write (2,*) 'ijkl',i,j,k,l
8436 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8437 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8439 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8440 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8441 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8442 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8444 if (j.lt.nres-1) then
8451 if (l.lt.nres-1) then
8461 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8462 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8463 C summed up outside the subrouine as for the other subroutines
8464 C handling long-range interactions. The old code is commented out
8465 C with "cgrad" to keep track of changes.
8467 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8468 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8469 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8470 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8471 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8472 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8473 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8474 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8475 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8476 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8478 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8479 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8480 cgrad ghalf=0.5d0*ggg1(ll)
8482 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8483 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8484 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8485 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8486 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8487 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8488 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8489 cgrad ghalf=0.5d0*ggg2(ll)
8491 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
8492 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8493 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
8494 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8495 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8496 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8502 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8503 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8508 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8509 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8515 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8520 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8524 cd write (2,*) iii,g_corr5_loc(iii)
8527 cd write (2,*) 'ekont',ekont
8528 cd write (iout,*) 'eello5',ekont*eel5
8531 c--------------------------------------------------------------------------
8532 double precision function eello6(i,j,k,l,jj,kk)
8533 implicit real*8 (a-h,o-z)
8534 include 'DIMENSIONS'
8535 include 'DIMENSIONS.ZSCOPT'
8536 include 'COMMON.IOUNITS'
8537 include 'COMMON.CHAIN'
8538 include 'COMMON.DERIV'
8539 include 'COMMON.INTERACT'
8540 include 'COMMON.CONTACTS'
8541 include 'COMMON.CONTMAT'
8542 include 'COMMON.CORRMAT'
8543 include 'COMMON.TORSION'
8544 include 'COMMON.VAR'
8545 include 'COMMON.GEO'
8546 include 'COMMON.FFIELD'
8547 double precision ggg1(3),ggg2(3)
8548 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8553 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8561 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8562 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8566 derx(lll,kkk,iii)=0.0d0
8570 cd eij=facont_hb(jj,i)
8571 cd ekl=facont_hb(kk,k)
8577 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8578 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8579 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8580 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8581 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8582 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8584 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8585 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8586 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8587 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8588 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8589 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8593 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8595 C If turn contributions are considered, they will be handled separately.
8596 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8597 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8598 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8599 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8600 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8601 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8602 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8605 if (j.lt.nres-1) then
8612 if (l.lt.nres-1) then
8620 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8621 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8622 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8623 cgrad ghalf=0.5d0*ggg1(ll)
8625 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8626 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8627 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8628 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8629 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8630 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8631 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8632 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8633 cgrad ghalf=0.5d0*ggg2(ll)
8634 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8636 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8637 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8638 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8639 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8640 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8641 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8647 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8648 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8653 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8654 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8660 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8665 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8669 cd write (2,*) iii,g_corr6_loc(iii)
8672 cd write (2,*) 'ekont',ekont
8673 cd write (iout,*) 'eello6',ekont*eel6
8676 c--------------------------------------------------------------------------
8677 double precision function eello6_graph1(i,j,k,l,imat,swap)
8678 implicit real*8 (a-h,o-z)
8679 include 'DIMENSIONS'
8680 include 'DIMENSIONS.ZSCOPT'
8681 include 'COMMON.IOUNITS'
8682 include 'COMMON.CHAIN'
8683 include 'COMMON.DERIV'
8684 include 'COMMON.INTERACT'
8685 include 'COMMON.CONTACTS'
8686 include 'COMMON.CONTMAT'
8687 include 'COMMON.CORRMAT'
8688 include 'COMMON.TORSION'
8689 include 'COMMON.VAR'
8690 include 'COMMON.GEO'
8691 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8695 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8697 C Parallel Antiparallel C
8703 C \ j|/k\| / \ |/k\|l / C
8708 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8709 itk=itype2loc(itype(k))
8710 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8711 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8712 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8713 call transpose2(EUgC(1,1,k),auxmat(1,1))
8714 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8715 vv1(1)=pizda1(1,1)-pizda1(2,2)
8716 vv1(2)=pizda1(1,2)+pizda1(2,1)
8717 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8718 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8719 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8720 s5=scalar2(vv(1),Dtobr2(1,i))
8721 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8722 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8724 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8725 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8726 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8727 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8728 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8729 & +scalar2(vv(1),Dtobr2der(1,i)))
8730 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8731 vv1(1)=pizda1(1,1)-pizda1(2,2)
8732 vv1(2)=pizda1(1,2)+pizda1(2,1)
8733 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8734 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8736 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8737 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8738 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8739 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8740 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8742 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8743 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8744 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8745 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8746 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8748 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8749 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8750 vv1(1)=pizda1(1,1)-pizda1(2,2)
8751 vv1(2)=pizda1(1,2)+pizda1(2,1)
8752 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8753 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8754 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8755 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8764 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8765 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8766 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8767 call transpose2(EUgC(1,1,k),auxmat(1,1))
8768 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8770 vv1(1)=pizda1(1,1)-pizda1(2,2)
8771 vv1(2)=pizda1(1,2)+pizda1(2,1)
8772 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8773 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8774 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8775 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8776 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8777 s5=scalar2(vv(1),Dtobr2(1,i))
8778 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8785 c----------------------------------------------------------------------------
8786 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8787 implicit real*8 (a-h,o-z)
8788 include 'DIMENSIONS'
8789 include 'DIMENSIONS.ZSCOPT'
8790 include 'COMMON.IOUNITS'
8791 include 'COMMON.CHAIN'
8792 include 'COMMON.DERIV'
8793 include 'COMMON.INTERACT'
8794 include 'COMMON.CONTACTS'
8795 include 'COMMON.CONTMAT'
8796 include 'COMMON.CORRMAT'
8797 include 'COMMON.TORSION'
8798 include 'COMMON.VAR'
8799 include 'COMMON.GEO'
8801 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8802 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8805 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8807 C Parallel Antiparallel C
8813 C \ j|/k\| \ |/k\|l C
8818 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8819 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8820 C AL 7/4/01 s1 would occur in the sixth-order moment,
8821 C but not in a cluster cumulant
8823 s1=dip(1,jj,i)*dip(1,kk,k)
8825 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8826 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8827 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8828 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8829 call transpose2(EUg(1,1,k),auxmat(1,1))
8830 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8831 vv(1)=pizda(1,1)-pizda(2,2)
8832 vv(2)=pizda(1,2)+pizda(2,1)
8833 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8834 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8836 eello6_graph2=-(s1+s2+s3+s4)
8838 eello6_graph2=-(s2+s3+s4)
8841 C Derivatives in gamma(i-1)
8845 s1=dipderg(1,jj,i)*dip(1,kk,k)
8847 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8848 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8849 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8850 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8852 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8854 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8856 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8858 C Derivatives in gamma(k-1)
8860 s1=dip(1,jj,i)*dipderg(1,kk,k)
8862 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8863 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8864 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8865 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8866 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8867 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8868 vv(1)=pizda(1,1)-pizda(2,2)
8869 vv(2)=pizda(1,2)+pizda(2,1)
8870 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8872 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8874 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8876 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8877 C Derivatives in gamma(j-1) or gamma(l-1)
8880 s1=dipderg(3,jj,i)*dip(1,kk,k)
8882 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8883 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8884 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8885 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8886 vv(1)=pizda(1,1)-pizda(2,2)
8887 vv(2)=pizda(1,2)+pizda(2,1)
8888 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8891 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8893 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8896 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8897 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8899 C Derivatives in gamma(l-1) or gamma(j-1)
8902 s1=dip(1,jj,i)*dipderg(3,kk,k)
8904 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8905 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8906 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8907 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8908 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8909 vv(1)=pizda(1,1)-pizda(2,2)
8910 vv(2)=pizda(1,2)+pizda(2,1)
8911 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8914 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8916 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8919 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8920 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8922 C Cartesian derivatives.
8924 write (2,*) 'In eello6_graph2'
8926 write (2,*) 'iii=',iii
8928 write (2,*) 'kkk=',kkk
8930 write (2,'(3(2f10.5),5x)')
8931 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8941 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8943 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8946 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8948 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8949 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8951 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8952 call transpose2(EUg(1,1,k),auxmat(1,1))
8953 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8955 vv(1)=pizda(1,1)-pizda(2,2)
8956 vv(2)=pizda(1,2)+pizda(2,1)
8957 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8958 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8960 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8962 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8965 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8967 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8975 c----------------------------------------------------------------------------
8976 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8977 implicit real*8 (a-h,o-z)
8978 include 'DIMENSIONS'
8979 include 'DIMENSIONS.ZSCOPT'
8980 include 'COMMON.IOUNITS'
8981 include 'COMMON.CHAIN'
8982 include 'COMMON.DERIV'
8983 include 'COMMON.INTERACT'
8984 include 'COMMON.CONTACTS'
8985 include 'COMMON.CONTMAT'
8986 include 'COMMON.CORRMAT'
8987 include 'COMMON.TORSION'
8988 include 'COMMON.VAR'
8989 include 'COMMON.GEO'
8990 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8992 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8994 C Parallel Antiparallel C
9000 C j|/k\| / |/k\|l / C
9005 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9007 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9008 C energy moment and not to the cluster cumulant.
9009 iti=itortyp(itype(i))
9010 if (j.lt.nres-1) then
9011 itj1=itype2loc(itype(j+1))
9015 itk=itype2loc(itype(k))
9016 itk1=itype2loc(itype(k+1))
9017 if (l.lt.nres-1) then
9018 itl1=itype2loc(itype(l+1))
9023 s1=dip(4,jj,i)*dip(4,kk,k)
9025 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9026 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9027 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9028 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9029 call transpose2(EE(1,1,k),auxmat(1,1))
9030 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9031 vv(1)=pizda(1,1)+pizda(2,2)
9032 vv(2)=pizda(2,1)-pizda(1,2)
9033 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9034 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9035 cd & "sum",-(s2+s3+s4)
9037 eello6_graph3=-(s1+s2+s3+s4)
9039 eello6_graph3=-(s2+s3+s4)
9042 C Derivatives in gamma(k-1)
9044 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9045 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9046 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9047 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9048 C Derivatives in gamma(l-1)
9049 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9050 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9051 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9052 vv(1)=pizda(1,1)+pizda(2,2)
9053 vv(2)=pizda(2,1)-pizda(1,2)
9054 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9055 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9056 C Cartesian derivatives.
9062 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9064 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9067 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9069 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9070 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9072 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9073 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9075 vv(1)=pizda(1,1)+pizda(2,2)
9076 vv(2)=pizda(2,1)-pizda(1,2)
9077 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9079 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9081 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9084 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9086 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9088 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9095 c----------------------------------------------------------------------------
9096 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9097 implicit real*8 (a-h,o-z)
9098 include 'DIMENSIONS'
9099 include 'DIMENSIONS.ZSCOPT'
9100 include 'COMMON.IOUNITS'
9101 include 'COMMON.CHAIN'
9102 include 'COMMON.DERIV'
9103 include 'COMMON.INTERACT'
9104 include 'COMMON.CONTACTS'
9105 include 'COMMON.CONTMAT'
9106 include 'COMMON.CORRMAT'
9107 include 'COMMON.TORSION'
9108 include 'COMMON.VAR'
9109 include 'COMMON.GEO'
9110 include 'COMMON.FFIELD'
9111 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9112 & auxvec1(2),auxmat1(2,2)
9114 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9116 C Parallel Antiparallel C
9122 C \ j|/k\| \ |/k\|l C
9127 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9129 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9130 C energy moment and not to the cluster cumulant.
9131 cd write (2,*) 'eello_graph4: wturn6',wturn6
9132 iti=itype2loc(itype(i))
9133 itj=itype2loc(itype(j))
9134 if (j.lt.nres-1) then
9135 itj1=itype2loc(itype(j+1))
9139 itk=itype2loc(itype(k))
9140 if (k.lt.nres-1) then
9141 itk1=itype2loc(itype(k+1))
9145 itl=itype2loc(itype(l))
9146 if (l.lt.nres-1) then
9147 itl1=itype2loc(itype(l+1))
9151 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9152 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9153 cd & ' itl',itl,' itl1',itl1
9156 s1=dip(3,jj,i)*dip(3,kk,k)
9158 s1=dip(2,jj,j)*dip(2,kk,l)
9161 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9162 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9164 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9165 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9167 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9168 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9170 call transpose2(EUg(1,1,k),auxmat(1,1))
9171 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9172 vv(1)=pizda(1,1)-pizda(2,2)
9173 vv(2)=pizda(2,1)+pizda(1,2)
9174 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9175 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9177 eello6_graph4=-(s1+s2+s3+s4)
9179 eello6_graph4=-(s2+s3+s4)
9181 C Derivatives in gamma(i-1)
9186 s1=dipderg(2,jj,i)*dip(3,kk,k)
9188 s1=dipderg(4,jj,j)*dip(2,kk,l)
9191 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9193 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9194 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9196 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9197 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9199 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9200 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9201 cd write (2,*) 'turn6 derivatives'
9203 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9205 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9209 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9211 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9215 C Derivatives in gamma(k-1)
9218 s1=dip(3,jj,i)*dipderg(2,kk,k)
9220 s1=dip(2,jj,j)*dipderg(4,kk,l)
9223 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9224 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9226 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9227 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9229 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9230 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9232 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9233 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9234 vv(1)=pizda(1,1)-pizda(2,2)
9235 vv(2)=pizda(2,1)+pizda(1,2)
9236 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9237 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9239 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9241 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9245 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9247 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9250 C Derivatives in gamma(j-1) or gamma(l-1)
9251 if (l.eq.j+1 .and. l.gt.1) then
9252 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9253 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9254 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9255 vv(1)=pizda(1,1)-pizda(2,2)
9256 vv(2)=pizda(2,1)+pizda(1,2)
9257 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9258 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9259 else if (j.gt.1) then
9260 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9261 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9262 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9263 vv(1)=pizda(1,1)-pizda(2,2)
9264 vv(2)=pizda(2,1)+pizda(1,2)
9265 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9266 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9267 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9269 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9272 C Cartesian derivatives.
9279 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9281 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9285 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9287 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9291 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9293 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9295 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9296 & b1(1,j+1),auxvec(1))
9297 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9299 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9300 & b1(1,l+1),auxvec(1))
9301 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9303 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9305 vv(1)=pizda(1,1)-pizda(2,2)
9306 vv(2)=pizda(2,1)+pizda(1,2)
9307 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9309 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9311 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9314 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9317 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9320 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9322 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9324 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9328 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9330 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9333 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9335 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9344 c----------------------------------------------------------------------------
9345 double precision function eello_turn6(i,jj,kk)
9346 implicit real*8 (a-h,o-z)
9347 include 'DIMENSIONS'
9348 include 'DIMENSIONS.ZSCOPT'
9349 include 'COMMON.IOUNITS'
9350 include 'COMMON.CHAIN'
9351 include 'COMMON.DERIV'
9352 include 'COMMON.INTERACT'
9353 include 'COMMON.CONTACTS'
9354 include 'COMMON.CONTMAT'
9355 include 'COMMON.CORRMAT'
9356 include 'COMMON.TORSION'
9357 include 'COMMON.VAR'
9358 include 'COMMON.GEO'
9359 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9360 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9362 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9363 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9364 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9365 C the respective energy moment and not to the cluster cumulant.
9374 iti=itype2loc(itype(i))
9375 itk=itype2loc(itype(k))
9376 itk1=itype2loc(itype(k+1))
9377 itl=itype2loc(itype(l))
9378 itj=itype2loc(itype(j))
9379 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9380 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9381 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9386 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9388 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9392 derx_turn(lll,kkk,iii)=0.0d0
9399 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9401 cd write (2,*) 'eello6_5',eello6_5
9403 call transpose2(AEA(1,1,1),auxmat(1,1))
9404 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9405 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9406 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9408 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9409 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9410 s2 = scalar2(b1(1,k),vtemp1(1))
9412 call transpose2(AEA(1,1,2),atemp(1,1))
9413 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9414 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
9415 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9417 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9418 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9419 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9421 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9422 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9423 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9424 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9425 ss13 = scalar2(b1(1,k),vtemp4(1))
9426 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9428 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9434 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9435 C Derivatives in gamma(i+2)
9440 call transpose2(AEA(1,1,1),auxmatd(1,1))
9441 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9442 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9443 call transpose2(AEAderg(1,1,2),atempd(1,1))
9444 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9445 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9447 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9448 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9449 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9455 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9456 C Derivatives in gamma(i+3)
9458 call transpose2(AEA(1,1,1),auxmatd(1,1))
9459 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9460 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9461 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9463 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9464 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9465 s2d = scalar2(b1(1,k),vtemp1d(1))
9467 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
9468 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
9470 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9472 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9473 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9474 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9482 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9483 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9485 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9486 & -0.5d0*ekont*(s2d+s12d)
9488 C Derivatives in gamma(i+4)
9489 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9490 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9491 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9493 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9494 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9495 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9503 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9505 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9507 C Derivatives in gamma(i+5)
9509 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9510 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9511 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9513 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9514 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9515 s2d = scalar2(b1(1,k),vtemp1d(1))
9517 call transpose2(AEA(1,1,2),atempd(1,1))
9518 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9519 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9521 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9522 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9524 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9525 ss13d = scalar2(b1(1,k),vtemp4d(1))
9526 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9534 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9535 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9537 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9538 & -0.5d0*ekont*(s2d+s12d)
9540 C Cartesian derivatives
9545 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9546 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9547 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9549 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9550 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9552 s2d = scalar2(b1(1,k),vtemp1d(1))
9554 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9555 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9556 s8d = -(atempd(1,1)+atempd(2,2))*
9557 & scalar2(cc(1,1,l),vtemp2(1))
9559 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9561 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9562 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9569 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9572 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9576 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9577 & - 0.5d0*(s8d+s12d)
9579 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9588 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9590 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9591 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9592 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9593 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9594 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9596 ss13d = scalar2(b1(1,k),vtemp4d(1))
9597 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9598 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9602 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9603 cd & 16*eel_turn6_num
9605 if (j.lt.nres-1) then
9612 if (l.lt.nres-1) then
9620 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9621 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9622 cgrad ghalf=0.5d0*ggg1(ll)
9624 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9625 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9626 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9627 & +ekont*derx_turn(ll,2,1)
9628 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9629 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9630 & +ekont*derx_turn(ll,4,1)
9631 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9632 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9633 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9634 cgrad ghalf=0.5d0*ggg2(ll)
9636 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9637 & +ekont*derx_turn(ll,2,2)
9638 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9639 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9640 & +ekont*derx_turn(ll,4,2)
9641 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9642 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9643 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9648 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9653 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9659 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9664 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9668 cd write (2,*) iii,g_corr6_loc(iii)
9671 eello_turn6=ekont*eel_turn6
9672 cd write (2,*) 'ekont',ekont
9673 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9677 crc-------------------------------------------------
9678 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9679 subroutine Eliptransfer(eliptran)
9680 implicit real*8 (a-h,o-z)
9681 include 'DIMENSIONS'
9682 include 'DIMENSIONS.ZSCOPT'
9683 include 'COMMON.GEO'
9684 include 'COMMON.VAR'
9685 include 'COMMON.LOCAL'
9686 include 'COMMON.CHAIN'
9687 include 'COMMON.DERIV'
9688 include 'COMMON.INTERACT'
9689 include 'COMMON.IOUNITS'
9690 include 'COMMON.CALC'
9691 include 'COMMON.CONTROL'
9692 include 'COMMON.SPLITELE'
9693 include 'COMMON.SBRIDGE'
9694 C this is done by Adasko
9698 C--bordliptop-- buffore starts
9699 C--bufliptop--- here true lipid starts
9701 C--buflipbot--- lipid ends buffore starts
9702 C--bordlipbot--buffore ends
9706 if (itype(i).eq.ntyp1) cycle
9708 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9709 if (positi.le.0) positi=positi+boxzsize
9711 C first for peptide groups
9712 c for each residue check if it is in lipid or lipid water border area
9713 if ((positi.gt.bordlipbot)
9714 &.and.(positi.lt.bordliptop)) then
9715 C the energy transfer exist
9716 if (positi.lt.buflipbot) then
9717 C what fraction I am in
9719 & ((positi-bordlipbot)/lipbufthick)
9720 C lipbufthick is thickenes of lipid buffore
9721 sslip=sscalelip(fracinbuf)
9722 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9723 eliptran=eliptran+sslip*pepliptran
9724 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9725 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9726 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9727 elseif (positi.gt.bufliptop) then
9728 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9729 sslip=sscalelip(fracinbuf)
9730 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9731 eliptran=eliptran+sslip*pepliptran
9732 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9733 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9734 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9735 C print *, "doing sscalefor top part"
9736 C print *,i,sslip,fracinbuf,ssgradlip
9738 eliptran=eliptran+pepliptran
9739 C print *,"I am in true lipid"
9742 C eliptran=elpitran+0.0 ! I am in water
9745 C print *, "nic nie bylo w lipidzie?"
9746 C now multiply all by the peptide group transfer factor
9747 C eliptran=eliptran*pepliptran
9748 C now the same for side chains
9751 if (itype(i).eq.ntyp1) cycle
9752 positi=(mod(c(3,i+nres),boxzsize))
9753 if (positi.le.0) positi=positi+boxzsize
9754 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9755 c for each residue check if it is in lipid or lipid water border area
9756 C respos=mod(c(3,i+nres),boxzsize)
9757 C print *,positi,bordlipbot,buflipbot
9758 if ((positi.gt.bordlipbot)
9759 & .and.(positi.lt.bordliptop)) then
9760 C the energy transfer exist
9761 if (positi.lt.buflipbot) then
9763 & ((positi-bordlipbot)/lipbufthick)
9764 C lipbufthick is thickenes of lipid buffore
9765 sslip=sscalelip(fracinbuf)
9766 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9767 eliptran=eliptran+sslip*liptranene(itype(i))
9768 gliptranx(3,i)=gliptranx(3,i)
9769 &+ssgradlip*liptranene(itype(i))
9770 gliptranc(3,i-1)= gliptranc(3,i-1)
9771 &+ssgradlip*liptranene(itype(i))
9772 C print *,"doing sccale for lower part"
9773 elseif (positi.gt.bufliptop) then
9775 &((bordliptop-positi)/lipbufthick)
9776 sslip=sscalelip(fracinbuf)
9777 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9778 eliptran=eliptran+sslip*liptranene(itype(i))
9779 gliptranx(3,i)=gliptranx(3,i)
9780 &+ssgradlip*liptranene(itype(i))
9781 gliptranc(3,i-1)= gliptranc(3,i-1)
9782 &+ssgradlip*liptranene(itype(i))
9783 C print *, "doing sscalefor top part",sslip,fracinbuf
9785 eliptran=eliptran+liptranene(itype(i))
9786 C print *,"I am in true lipid"
9788 endif ! if in lipid or buffor
9790 C eliptran=elpitran+0.0 ! I am in water
9796 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9798 SUBROUTINE MATVEC2(A1,V1,V2)
9799 implicit real*8 (a-h,o-z)
9800 include 'DIMENSIONS'
9801 DIMENSION A1(2,2),V1(2),V2(2)
9805 c 3 VI=VI+A1(I,K)*V1(K)
9809 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9810 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9815 C---------------------------------------
9816 SUBROUTINE MATMAT2(A1,A2,A3)
9817 implicit real*8 (a-h,o-z)
9818 include 'DIMENSIONS'
9819 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9820 c DIMENSION AI3(2,2)
9824 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9830 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9831 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9832 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9833 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9841 c-------------------------------------------------------------------------
9842 double precision function scalar2(u,v)
9844 double precision u(2),v(2)
9847 scalar2=u(1)*v(1)+u(2)*v(2)
9851 C-----------------------------------------------------------------------------
9853 subroutine transpose2(a,at)
9855 double precision a(2,2),at(2,2)
9862 c--------------------------------------------------------------------------
9863 subroutine transpose(n,a,at)
9866 double precision a(n,n),at(n,n)
9874 C---------------------------------------------------------------------------
9875 subroutine prodmat3(a1,a2,kk,transp,prod)
9878 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9880 crc double precision auxmat(2,2),prod_(2,2)
9883 crc call transpose2(kk(1,1),auxmat(1,1))
9884 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9885 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9887 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9888 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9889 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9890 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9891 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9892 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9893 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9894 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9897 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9898 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9900 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9901 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9902 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9903 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9904 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9905 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9906 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9907 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9910 c call transpose2(a2(1,1),a2t(1,1))
9913 crc print *,((prod_(i,j),i=1,2),j=1,2)
9914 crc print *,((prod(i,j),i=1,2),j=1,2)
9918 C-----------------------------------------------------------------------------
9919 double precision function scalar(u,v)
9921 double precision u(3),v(3)
9931 C-----------------------------------------------------------------------
9932 double precision function sscale(r)
9933 double precision r,gamm
9934 include "COMMON.SPLITELE"
9935 if(r.lt.r_cut-rlamb) then
9937 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9938 gamm=(r-(r_cut-rlamb))/rlamb
9939 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9945 C-----------------------------------------------------------------------
9946 C-----------------------------------------------------------------------
9947 double precision function sscagrad(r)
9948 double precision r,gamm
9949 include "COMMON.SPLITELE"
9950 if(r.lt.r_cut-rlamb) then
9952 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9953 gamm=(r-(r_cut-rlamb))/rlamb
9954 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9960 C-----------------------------------------------------------------------
9961 C-----------------------------------------------------------------------
9962 double precision function sscalelip(r)
9963 double precision r,gamm
9964 include "COMMON.SPLITELE"
9965 C if(r.lt.r_cut-rlamb) then
9967 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9968 C gamm=(r-(r_cut-rlamb))/rlamb
9969 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9975 C-----------------------------------------------------------------------
9976 double precision function sscagradlip(r)
9977 double precision r,gamm
9978 include "COMMON.SPLITELE"
9979 C if(r.lt.r_cut-rlamb) then
9981 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9982 C gamm=(r-(r_cut-rlamb))/rlamb
9983 sscagradlip=r*(6*r-6.0d0)
9990 C-----------------------------------------------------------------------
9991 subroutine set_shield_fac
9992 implicit real*8 (a-h,o-z)
9993 include 'DIMENSIONS'
9994 include 'DIMENSIONS.ZSCOPT'
9995 include 'COMMON.CHAIN'
9996 include 'COMMON.DERIV'
9997 include 'COMMON.IOUNITS'
9998 include 'COMMON.SHIELD'
9999 include 'COMMON.INTERACT'
10000 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10001 double precision div77_81/0.974996043d0/,
10002 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10004 C the vector between center of side_chain and peptide group
10005 double precision pep_side(3),long,side_calf(3),
10006 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10007 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10008 C the line belowe needs to be changed for FGPROC>1
10010 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10012 Cif there two consequtive dummy atoms there is no peptide group between them
10013 C the line below has to be changed for FGPROC>1
10016 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10020 C first lets set vector conecting the ithe side-chain with kth side-chain
10021 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10022 C pep_side(j)=2.0d0
10023 C and vector conecting the side-chain with its proper calfa
10024 side_calf(j)=c(j,k+nres)-c(j,k)
10025 C side_calf(j)=2.0d0
10026 pept_group(j)=c(j,i)-c(j,i+1)
10027 C lets have their lenght
10028 dist_pep_side=pep_side(j)**2+dist_pep_side
10029 dist_side_calf=dist_side_calf+side_calf(j)**2
10030 dist_pept_group=dist_pept_group+pept_group(j)**2
10032 dist_pep_side=dsqrt(dist_pep_side)
10033 dist_pept_group=dsqrt(dist_pept_group)
10034 dist_side_calf=dsqrt(dist_side_calf)
10036 pep_side_norm(j)=pep_side(j)/dist_pep_side
10037 side_calf_norm(j)=dist_side_calf
10039 C now sscale fraction
10040 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10041 C print *,buff_shield,"buff"
10043 if (sh_frac_dist.le.0.0) cycle
10044 C If we reach here it means that this side chain reaches the shielding sphere
10045 C Lets add him to the list for gradient
10046 ishield_list(i)=ishield_list(i)+1
10047 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10048 C this list is essential otherwise problem would be O3
10049 shield_list(ishield_list(i),i)=k
10050 C Lets have the sscale value
10051 if (sh_frac_dist.gt.1.0) then
10052 scale_fac_dist=1.0d0
10054 sh_frac_dist_grad(j)=0.0d0
10057 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10058 & *(2.0*sh_frac_dist-3.0d0)
10059 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
10060 & /dist_pep_side/buff_shield*0.5
10061 C remember for the final gradient multiply sh_frac_dist_grad(j)
10062 C for side_chain by factor -2 !
10064 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10065 C print *,"jestem",scale_fac_dist,fac_help_scale,
10066 C & sh_frac_dist_grad(j)
10069 C if ((i.eq.3).and.(k.eq.2)) then
10070 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
10074 C this is what is now we have the distance scaling now volume...
10075 short=short_r_sidechain(itype(k))
10076 long=long_r_sidechain(itype(k))
10077 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
10080 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
10081 C costhet_fac=0.0d0
10083 costhet_grad(j)=costhet_fac*pep_side(j)
10085 C remember for the final gradient multiply costhet_grad(j)
10086 C for side_chain by factor -2 !
10087 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10088 C pep_side0pept_group is vector multiplication
10089 pep_side0pept_group=0.0
10091 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10093 cosalfa=(pep_side0pept_group/
10094 & (dist_pep_side*dist_side_calf))
10095 fac_alfa_sin=1.0-cosalfa**2
10096 fac_alfa_sin=dsqrt(fac_alfa_sin)
10097 rkprim=fac_alfa_sin*(long-short)+short
10099 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
10100 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
10103 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10104 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10105 &*(long-short)/fac_alfa_sin*cosalfa/
10106 &((dist_pep_side*dist_side_calf))*
10107 &((side_calf(j))-cosalfa*
10108 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10110 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10111 &*(long-short)/fac_alfa_sin*cosalfa
10112 &/((dist_pep_side*dist_side_calf))*
10114 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10117 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10120 C now the gradient...
10121 C grad_shield is gradient of Calfa for peptide groups
10122 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
10124 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
10125 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
10127 grad_shield(j,i)=grad_shield(j,i)
10128 C gradient po skalowaniu
10129 & +(sh_frac_dist_grad(j)
10130 C gradient po costhet
10131 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10132 &-scale_fac_dist*(cosphi_grad_long(j))
10133 &/(1.0-cosphi) )*div77_81
10135 C grad_shield_side is Cbeta sidechain gradient
10136 grad_shield_side(j,ishield_list(i),i)=
10137 & (sh_frac_dist_grad(j)*(-2.0d0)
10138 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10139 & +scale_fac_dist*(cosphi_grad_long(j))
10140 & *2.0d0/(1.0-cosphi))
10141 & *div77_81*VofOverlap
10143 grad_shield_loc(j,ishield_list(i),i)=
10144 & scale_fac_dist*cosphi_grad_loc(j)
10145 & *2.0d0/(1.0-cosphi)
10146 & *div77_81*VofOverlap
10148 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10150 fac_shield(i)=VolumeTotal*div77_81+div4_81
10151 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10155 C--------------------------------------------------------------------------
10156 C first for shielding is setting of function of side-chains
10157 subroutine set_shield_fac2
10158 implicit real*8 (a-h,o-z)
10159 include 'DIMENSIONS'
10160 include 'DIMENSIONS.ZSCOPT'
10161 include 'COMMON.CHAIN'
10162 include 'COMMON.DERIV'
10163 include 'COMMON.IOUNITS'
10164 include 'COMMON.SHIELD'
10165 include 'COMMON.INTERACT'
10166 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10167 double precision div77_81/0.974996043d0/,
10168 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10170 C the vector between center of side_chain and peptide group
10171 double precision pep_side(3),long,side_calf(3),
10172 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10173 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10174 C the line belowe needs to be changed for FGPROC>1
10176 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10178 Cif there two consequtive dummy atoms there is no peptide group between them
10179 C the line below has to be changed for FGPROC>1
10182 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10186 C first lets set vector conecting the ithe side-chain with kth side-chain
10187 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10188 C pep_side(j)=2.0d0
10189 C and vector conecting the side-chain with its proper calfa
10190 side_calf(j)=c(j,k+nres)-c(j,k)
10191 C side_calf(j)=2.0d0
10192 pept_group(j)=c(j,i)-c(j,i+1)
10193 C lets have their lenght
10194 dist_pep_side=pep_side(j)**2+dist_pep_side
10195 dist_side_calf=dist_side_calf+side_calf(j)**2
10196 dist_pept_group=dist_pept_group+pept_group(j)**2
10198 dist_pep_side=dsqrt(dist_pep_side)
10199 dist_pept_group=dsqrt(dist_pept_group)
10200 dist_side_calf=dsqrt(dist_side_calf)
10202 pep_side_norm(j)=pep_side(j)/dist_pep_side
10203 side_calf_norm(j)=dist_side_calf
10205 C now sscale fraction
10206 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10207 C print *,buff_shield,"buff"
10209 if (sh_frac_dist.le.0.0) cycle
10210 C If we reach here it means that this side chain reaches the shielding sphere
10211 C Lets add him to the list for gradient
10212 ishield_list(i)=ishield_list(i)+1
10213 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10214 C this list is essential otherwise problem would be O3
10215 shield_list(ishield_list(i),i)=k
10216 C Lets have the sscale value
10217 if (sh_frac_dist.gt.1.0) then
10218 scale_fac_dist=1.0d0
10220 sh_frac_dist_grad(j)=0.0d0
10223 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10224 & *(2.0d0*sh_frac_dist-3.0d0)
10225 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
10226 & /dist_pep_side/buff_shield*0.5d0
10227 C remember for the final gradient multiply sh_frac_dist_grad(j)
10228 C for side_chain by factor -2 !
10230 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10231 C sh_frac_dist_grad(j)=0.0d0
10232 C scale_fac_dist=1.0d0
10233 C print *,"jestem",scale_fac_dist,fac_help_scale,
10234 C & sh_frac_dist_grad(j)
10237 C this is what is now we have the distance scaling now volume...
10238 short=short_r_sidechain(itype(k))
10239 long=long_r_sidechain(itype(k))
10240 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
10241 sinthet=short/dist_pep_side*costhet
10245 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
10246 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
10247 C & -short/dist_pep_side**2/costhet)
10248 C costhet_fac=0.0d0
10250 costhet_grad(j)=costhet_fac*pep_side(j)
10252 C remember for the final gradient multiply costhet_grad(j)
10253 C for side_chain by factor -2 !
10254 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10255 C pep_side0pept_group is vector multiplication
10256 pep_side0pept_group=0.0d0
10258 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10260 cosalfa=(pep_side0pept_group/
10261 & (dist_pep_side*dist_side_calf))
10262 fac_alfa_sin=1.0d0-cosalfa**2
10263 fac_alfa_sin=dsqrt(fac_alfa_sin)
10264 rkprim=fac_alfa_sin*(long-short)+short
10268 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
10270 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
10271 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
10272 & dist_pep_side**2)
10275 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10276 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10277 &*(long-short)/fac_alfa_sin*cosalfa/
10278 &((dist_pep_side*dist_side_calf))*
10279 &((side_calf(j))-cosalfa*
10280 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10281 C cosphi_grad_long(j)=0.0d0
10282 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10283 &*(long-short)/fac_alfa_sin*cosalfa
10284 &/((dist_pep_side*dist_side_calf))*
10286 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10287 C cosphi_grad_loc(j)=0.0d0
10289 C print *,sinphi,sinthet
10290 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
10293 C now the gradient...
10295 grad_shield(j,i)=grad_shield(j,i)
10296 C gradient po skalowaniu
10297 & +(sh_frac_dist_grad(j)*VofOverlap
10298 C gradient po costhet
10299 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
10300 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10301 & sinphi/sinthet*costhet*costhet_grad(j)
10302 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10304 C grad_shield_side is Cbeta sidechain gradient
10305 grad_shield_side(j,ishield_list(i),i)=
10306 & (sh_frac_dist_grad(j)*(-2.0d0)
10308 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10309 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10310 & sinphi/sinthet*costhet*costhet_grad(j)
10311 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10314 grad_shield_loc(j,ishield_list(i),i)=
10315 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10316 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
10317 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
10321 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10323 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
10324 c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i),
10325 c & " wshield",wshield
10326 c write(2,*) "TU",rpp(1,1),short,long,buff_shield
10330 C--------------------------------------------------------------------------
10331 double precision function tschebyshev(m,n,x,y)
10333 include "DIMENSIONS"
10335 double precision x(n),y,yy(0:maxvar),aux
10336 c Tschebyshev polynomial. Note that the first term is omitted
10337 c m=0: the constant term is included
10338 c m=1: the constant term is not included
10342 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
10351 C--------------------------------------------------------------------------
10352 double precision function gradtschebyshev(m,n,x,y)
10354 include "DIMENSIONS"
10356 double precision x(n+1),y,yy(0:maxvar),aux
10357 c Tschebyshev polynomial. Note that the first term is omitted
10358 c m=0: the constant term is included
10359 c m=1: the constant term is not included
10363 yy(i)=2*y*yy(i-1)-yy(i-2)
10367 aux=aux+x(i+1)*yy(i)*(i+1)
10368 C print *, x(i+1),yy(i),i
10370 gradtschebyshev=aux
10373 c----------------------------------------------------------------------------
10374 double precision function sscale2(r,r_cut,r0,rlamb)
10376 double precision r,gamm,r_cut,r0,rlamb,rr
10378 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
10379 c write (2,*) "rr",rr
10380 if(rr.lt.r_cut-rlamb) then
10382 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10383 gamm=(rr-(r_cut-rlamb))/rlamb
10384 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10390 C-----------------------------------------------------------------------
10391 double precision function sscalgrad2(r,r_cut,r0,rlamb)
10393 double precision r,gamm,r_cut,r0,rlamb,rr
10395 if(rr.lt.r_cut-rlamb) then
10397 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10398 gamm=(rr-(r_cut-rlamb))/rlamb
10400 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
10402 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
10409 c----------------------------------------------------------------------------
10410 subroutine e_saxs(Esaxs_constr)
10412 include 'DIMENSIONS'
10413 include 'DIMENSIONS.ZSCOPT'
10414 include 'DIMENSIONS.FREE'
10417 include "COMMON.SETUP"
10420 include 'COMMON.SBRIDGE'
10421 include 'COMMON.CHAIN'
10422 include 'COMMON.GEO'
10423 include 'COMMON.LOCAL'
10424 include 'COMMON.INTERACT'
10425 include 'COMMON.VAR'
10426 include 'COMMON.IOUNITS'
10427 include 'COMMON.DERIV'
10428 include 'COMMON.CONTROL'
10429 include 'COMMON.NAMES'
10430 include 'COMMON.FFIELD'
10431 include 'COMMON.LANGEVIN'
10432 include 'COMMON.SAXS'
10434 double precision Esaxs_constr
10435 integer i,iint,j,k,l
10436 double precision PgradC(maxSAXS,3,maxres),
10437 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
10439 double precision PgradC_(maxSAXS,3,maxres),
10440 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
10442 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
10443 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
10444 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
10445 & auxX,auxX1,CACAgrad,Cnorm
10446 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
10447 double precision dist
10449 c SAXS restraint penalty function
10451 write(iout,*) "------- SAXS penalty function start -------"
10452 write (iout,*) "nsaxs",nsaxs
10453 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
10454 write (iout,*) "Psaxs"
10456 write (iout,'(i5,e15.5)') i, Psaxs(i)
10459 Esaxs_constr = 0.0d0
10464 PgradC(k,l,j)=0.0d0
10465 PgradX(k,l,j)=0.0d0
10469 do i=iatsc_s,iatsc_e
10470 if (itype(i).eq.ntyp1) cycle
10471 do iint=1,nint_gr(i)
10472 do j=istart(i,iint),iend(i,iint)
10473 if (itype(j).eq.ntyp1) cycle
10476 dijCASC=dist(i,j+nres)
10477 dijSCCA=dist(i+nres,j)
10478 dijSCSC=dist(i+nres,j+nres)
10479 sigma2CACA=2.0d0/(pstok**2)
10480 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
10481 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
10482 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
10485 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10486 if (itype(j).ne.10) then
10487 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
10491 if (itype(i).ne.10) then
10492 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
10496 if (itype(i).ne.10 .and. itype(j).ne.10) then
10497 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
10501 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
10503 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10505 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10506 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
10507 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
10508 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
10511 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10512 PgradC(k,l,i) = PgradC(k,l,i)-aux
10513 PgradC(k,l,j) = PgradC(k,l,j)+aux
10515 if (itype(j).ne.10) then
10516 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
10517 PgradC(k,l,i) = PgradC(k,l,i)-aux
10518 PgradC(k,l,j) = PgradC(k,l,j)+aux
10519 PgradX(k,l,j) = PgradX(k,l,j)+aux
10522 if (itype(i).ne.10) then
10523 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
10524 PgradX(k,l,i) = PgradX(k,l,i)-aux
10525 PgradC(k,l,i) = PgradC(k,l,i)-aux
10526 PgradC(k,l,j) = PgradC(k,l,j)+aux
10529 if (itype(i).ne.10 .and. itype(j).ne.10) then
10530 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
10531 PgradC(k,l,i) = PgradC(k,l,i)-aux
10532 PgradC(k,l,j) = PgradC(k,l,j)+aux
10533 PgradX(k,l,i) = PgradX(k,l,i)-aux
10534 PgradX(k,l,j) = PgradX(k,l,j)+aux
10540 sigma2CACA=scal_rad**2*0.25d0/
10541 & (restok(itype(j))**2+restok(itype(i))**2)
10543 IF (saxs_cutoff.eq.0) THEN
10546 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10547 Pcalc(k) = Pcalc(k)+expCACA
10548 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10550 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10551 PgradC(k,l,i) = PgradC(k,l,i)-aux
10552 PgradC(k,l,j) = PgradC(k,l,j)+aux
10556 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
10559 c write (2,*) "ijk",i,j,k
10560 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
10561 if (sss2.eq.0.0d0) cycle
10562 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
10563 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
10564 Pcalc(k) = Pcalc(k)+expCACA
10566 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10568 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
10569 & ssgrad2*expCACA/sss2
10572 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10573 PgradC(k,l,i) = PgradC(k,l,i)+aux
10574 PgradC(k,l,j) = PgradC(k,l,j)-aux
10583 if (nfgtasks.gt.1) then
10584 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
10585 & MPI_SUM,king,FG_COMM,IERR)
10586 if (fg_rank.eq.king) then
10588 Pcalc(k) = Pcalc_(k)
10591 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
10592 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10593 if (fg_rank.eq.king) then
10597 PgradC(k,l,i) = PgradC_(k,l,i)
10603 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
10604 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10605 if (fg_rank.eq.king) then
10609 PgradX(k,l,i) = PgradX_(k,l,i)
10618 if (fg_rank.eq.king) then
10622 Cnorm = Cnorm + Pcalc(k)
10624 Esaxs_constr = dlog(Cnorm)-wsaxs0
10626 if (Pcalc(k).gt.0.0d0)
10627 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
10629 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
10633 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
10643 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
10644 auxC1 = auxC1+PgradC(k,l,i)
10646 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
10647 auxX1 = auxX1+PgradX(k,l,i)
10650 gsaxsC(l,i) = auxC - auxC1/Cnorm
10652 gsaxsX(l,i) = auxX - auxX1/Cnorm
10654 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
10655 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
10663 c----------------------------------------------------------------------------
10664 subroutine e_saxsC(Esaxs_constr)
10666 include 'DIMENSIONS'
10667 include 'DIMENSIONS.ZSCOPT'
10668 include 'DIMENSIONS.FREE'
10671 include "COMMON.SETUP"
10674 include 'COMMON.SBRIDGE'
10675 include 'COMMON.CHAIN'
10676 include 'COMMON.GEO'
10677 include 'COMMON.LOCAL'
10678 include 'COMMON.INTERACT'
10679 include 'COMMON.VAR'
10680 include 'COMMON.IOUNITS'
10681 include 'COMMON.DERIV'
10682 include 'COMMON.CONTROL'
10683 include 'COMMON.NAMES'
10684 include 'COMMON.FFIELD'
10685 include 'COMMON.LANGEVIN'
10686 include 'COMMON.SAXS'
10688 double precision Esaxs_constr
10689 integer i,iint,j,k,l
10690 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
10692 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
10694 double precision dk,dijCASPH,dijSCSPH,
10695 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
10696 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10698 c SAXS restraint penalty function
10700 write(iout,*) "------- SAXS penalty function start -------"
10701 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10702 & " isaxs_end",isaxs_end
10703 write (iout,*) "nnt",nnt," ntc",nct
10705 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10706 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10709 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10712 Esaxs_constr = 0.0d0
10714 do j=isaxs_start,isaxs_end
10726 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10728 if (itype(i).ne.10) then
10730 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10733 sigma2CA=2.0d0/pstok**2
10734 sigma2SC=4.0d0/restok(itype(i))**2
10735 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10736 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10737 Pcalc = Pcalc+expCASPH+expSCSPH
10739 write(*,*) "processor i j Pcalc",
10740 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
10742 CASPHgrad = sigma2CA*expCASPH
10743 SCSPHgrad = sigma2SC*expSCSPH
10745 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10746 PgradX(l,i) = PgradX(l,i) + aux
10747 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10752 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
10753 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
10756 logPtot = logPtot - dlog(Pcalc)
10757 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
10758 c & " logPtot",logPtot
10761 if (nfgtasks.gt.1) then
10762 c write (iout,*) "logPtot before reduction",logPtot
10763 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10764 & MPI_SUM,king,FG_COMM,IERR)
10766 c write (iout,*) "logPtot after reduction",logPtot
10767 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10768 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10769 if (fg_rank.eq.king) then
10772 gsaxsC(l,i) = gsaxsC_(l,i)
10776 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10777 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10778 if (fg_rank.eq.king) then
10781 gsaxsX(l,i) = gsaxsX_(l,i)
10787 Esaxs_constr = logPtot