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,'(a,2i5,3f10.5)')
1346 & 'r sss evdw',i,j,1.0d0/rij,sss,evdwij
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
1799 innt=chain_border(1,ii)
1800 inct=chain_border(2,ii)
1801 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1802 if (i.gt. innt+2 .and. i.lt.inct+2) then
1803 iti = itype2loc(itype(i-2))
1807 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1808 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1809 if (i.gt. innt+1 .and. i.lt.inct+1) then
1810 iti1 = itype2loc(itype(i-1))
1815 cost1=dcos(theta(i-1))
1816 sint1=dsin(theta(i-1))
1818 sint1cub=sint1sq*sint1
1819 sint1cost1=2*sint1*cost1
1821 write (iout,*) "bnew1",i,iti
1822 write (iout,*) (bnew1(k,1,iti),k=1,3)
1823 write (iout,*) (bnew1(k,2,iti),k=1,3)
1824 write (iout,*) "bnew2",i,iti
1825 write (iout,*) (bnew2(k,1,iti),k=1,3)
1826 write (iout,*) (bnew2(k,2,iti),k=1,3)
1829 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1831 gtb1(k,i-2)=cost1*b1k-sint1sq*
1832 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1833 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1835 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1836 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1839 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1840 cc(1,k,i-2)=sint1sq*aux
1841 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1842 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1843 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1844 dd(1,k,i-2)=sint1sq*aux
1845 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1846 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1848 cc(2,1,i-2)=cc(1,2,i-2)
1849 cc(2,2,i-2)=-cc(1,1,i-2)
1850 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1851 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1852 dd(2,1,i-2)=dd(1,2,i-2)
1853 dd(2,2,i-2)=-dd(1,1,i-2)
1854 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1855 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1858 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1859 EE(l,k,i-2)=sint1sq*aux
1861 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1864 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1865 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1866 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1867 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1869 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1870 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1871 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1873 c b1tilde(1,i-2)=b1(1,i-2)
1874 c b1tilde(2,i-2)=-b1(2,i-2)
1875 c b2tilde(1,i-2)=b2(1,i-2)
1876 c b2tilde(2,i-2)=-b2(2,i-2)
1878 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1879 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1880 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1881 write (iout,*) 'theta=', theta(i-1)
1884 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1885 c iti = itype2loc(itype(i-2))
1889 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1890 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1891 c iti1 = itype2loc(itype(i-1))
1901 CC(k,l,i-2)=ccold(k,l,iti)
1902 DD(k,l,i-2)=ddold(k,l,iti)
1903 EE(k,l,i-2)=eeold(k,l,iti)
1907 b1tilde(1,i-2)= b1(1,i-2)
1908 b1tilde(2,i-2)=-b1(2,i-2)
1909 b2tilde(1,i-2)= b2(1,i-2)
1910 b2tilde(2,i-2)=-b2(2,i-2)
1912 Ctilde(1,1,i-2)= CC(1,1,i-2)
1913 Ctilde(1,2,i-2)= CC(1,2,i-2)
1914 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1915 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1917 Dtilde(1,1,i-2)= DD(1,1,i-2)
1918 Dtilde(1,2,i-2)= DD(1,2,i-2)
1919 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1920 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1922 write(iout,*) "i",i," iti",iti
1923 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1924 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1928 if (i .lt. nres+1) then
1965 if (i .gt. 3 .and. i .lt. nres+1) then
1966 obrot_der(1,i-2)=-sin1
1967 obrot_der(2,i-2)= cos1
1968 Ugder(1,1,i-2)= sin1
1969 Ugder(1,2,i-2)=-cos1
1970 Ugder(2,1,i-2)=-cos1
1971 Ugder(2,2,i-2)=-sin1
1974 obrot2_der(1,i-2)=-dwasin2
1975 obrot2_der(2,i-2)= dwacos2
1976 Ug2der(1,1,i-2)= dwasin2
1977 Ug2der(1,2,i-2)=-dwacos2
1978 Ug2der(2,1,i-2)=-dwacos2
1979 Ug2der(2,2,i-2)=-dwasin2
1981 obrot_der(1,i-2)=0.0d0
1982 obrot_der(2,i-2)=0.0d0
1983 Ugder(1,1,i-2)=0.0d0
1984 Ugder(1,2,i-2)=0.0d0
1985 Ugder(2,1,i-2)=0.0d0
1986 Ugder(2,2,i-2)=0.0d0
1987 obrot2_der(1,i-2)=0.0d0
1988 obrot2_der(2,i-2)=0.0d0
1989 Ug2der(1,1,i-2)=0.0d0
1990 Ug2der(1,2,i-2)=0.0d0
1991 Ug2der(2,1,i-2)=0.0d0
1992 Ug2der(2,2,i-2)=0.0d0
1994 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1995 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1996 iti = itype2loc(itype(i-2))
2000 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2001 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2002 iti1 = itype2loc(itype(i-1))
2006 cd write (iout,*) '*******i',i,' iti1',iti
2007 cd write (iout,*) 'b1',b1(:,iti)
2008 cd write (iout,*) 'b2',b2(:,iti)
2009 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2010 c if (i .gt. iatel_s+2) then
2011 if (i .gt. nnt+2) then
2012 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2014 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2015 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2017 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
2018 c & EE(1,2,iti),EE(2,2,i)
2019 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2020 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2021 c write(iout,*) "Macierz EUG",
2022 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2025 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2027 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
2028 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
2029 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2030 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
2031 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
2043 DtUg2(l,k,i-2)=0.0d0
2047 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2048 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2050 muder(k,i-2)=Ub2der(k,i-2)
2052 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2053 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2054 if (itype(i-1).le.ntyp) then
2055 iti1 = itype2loc(itype(i-1))
2063 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2066 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2067 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2068 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2069 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2070 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2071 & ((ee(l,k,i-2),l=1,2),k=1,2)
2073 cd write (iout,*) 'mu1',mu1(:,i-2)
2074 cd write (iout,*) 'mu2',mu2(:,i-2)
2076 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2079 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2080 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2081 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2082 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2083 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2085 C Vectors and matrices dependent on a single virtual-bond dihedral.
2086 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2087 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2088 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2089 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2090 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2092 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2093 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2094 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2095 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2101 C Matrices dependent on two consecutive virtual-bond dihedrals.
2102 C The order of matrices is from left to right.
2103 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2106 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2108 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2109 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2111 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2112 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2114 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2115 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2116 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2123 C--------------------------------------------------------------------------
2124 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2126 C This subroutine calculates the average interaction energy and its gradient
2127 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2128 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2129 C The potential depends both on the distance of peptide-group centers and on
2130 C the orientation of the CA-CA virtual bonds.
2132 implicit real*8 (a-h,o-z)
2136 include 'DIMENSIONS'
2137 include 'DIMENSIONS.ZSCOPT'
2138 include 'COMMON.CONTROL'
2139 include 'COMMON.IOUNITS'
2140 include 'COMMON.GEO'
2141 include 'COMMON.VAR'
2142 include 'COMMON.LOCAL'
2143 include 'COMMON.CHAIN'
2144 include 'COMMON.DERIV'
2145 include 'COMMON.INTERACT'
2147 include 'COMMON.CONTACTS'
2148 include 'COMMON.CONTMAT'
2150 include 'COMMON.CORRMAT'
2151 include 'COMMON.TORSION'
2152 include 'COMMON.VECTORS'
2153 include 'COMMON.FFIELD'
2154 include 'COMMON.TIME1'
2155 include 'COMMON.SPLITELE'
2156 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2157 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2158 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2159 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2160 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2161 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2163 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2165 double precision scal_el /1.0d0/
2167 double precision scal_el /0.5d0/
2170 C 13-go grudnia roku pamietnego...
2171 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2172 & 0.0d0,1.0d0,0.0d0,
2173 & 0.0d0,0.0d0,1.0d0/
2174 cd write(iout,*) 'In EELEC'
2176 cd write(iout,*) 'Type',i
2177 cd write(iout,*) 'B1',B1(:,i)
2178 cd write(iout,*) 'B2',B2(:,i)
2179 cd write(iout,*) 'CC',CC(:,:,i)
2180 cd write(iout,*) 'DD',DD(:,:,i)
2181 cd write(iout,*) 'EE',EE(:,:,i)
2183 cd call check_vecgrad
2185 if (icheckgrad.eq.1) then
2187 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2189 dc_norm(k,i)=dc(k,i)*fac
2191 c write (iout,*) 'i',i,' fac',fac
2194 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2195 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2196 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2197 c call vec_and_deriv
2203 time_mat=time_mat+MPI_Wtime()-time01
2207 cd write (iout,*) 'i=',i
2209 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2212 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2213 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2228 cd print '(a)','Enter EELEC'
2229 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2231 gel_loc_loc(i)=0.0d0
2236 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2238 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2240 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2241 do i=iturn3_start,iturn3_end
2243 C write(iout,*) "tu jest i",i
2244 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2245 C changes suggested by Ana to avoid out of bounds
2246 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2247 c & .or.((i+4).gt.nres)
2248 c & .or.((i-1).le.0)
2249 C end of changes by Ana
2250 C dobra zmiana wycofana
2251 & .or. itype(i+2).eq.ntyp1
2252 & .or. itype(i+3).eq.ntyp1) cycle
2253 C Adam: Instructions below will switch off existing interactions
2255 c if(itype(i-1).eq.ntyp1)cycle
2257 c if(i.LT.nres-3)then
2258 c if (itype(i+4).eq.ntyp1) cycle
2263 dx_normi=dc_norm(1,i)
2264 dy_normi=dc_norm(2,i)
2265 dz_normi=dc_norm(3,i)
2266 xmedi=c(1,i)+0.5d0*dxi
2267 ymedi=c(2,i)+0.5d0*dyi
2268 zmedi=c(3,i)+0.5d0*dzi
2269 xmedi=mod(xmedi,boxxsize)
2270 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2271 ymedi=mod(ymedi,boxysize)
2272 if (ymedi.lt.0) ymedi=ymedi+boxysize
2273 zmedi=mod(zmedi,boxzsize)
2274 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2276 call eelecij(i,i+2,ees,evdw1,eel_loc)
2277 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2279 num_cont_hb(i)=num_conti
2282 do i=iturn4_start,iturn4_end
2284 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2285 C changes suggested by Ana to avoid out of bounds
2286 c & .or.((i+5).gt.nres)
2287 c & .or.((i-1).le.0)
2288 C end of changes suggested by Ana
2289 & .or. itype(i+3).eq.ntyp1
2290 & .or. itype(i+4).eq.ntyp1
2291 c & .or. itype(i+5).eq.ntyp1
2292 c & .or. itype(i).eq.ntyp1
2293 c & .or. itype(i-1).eq.ntyp1
2298 dx_normi=dc_norm(1,i)
2299 dy_normi=dc_norm(2,i)
2300 dz_normi=dc_norm(3,i)
2301 xmedi=c(1,i)+0.5d0*dxi
2302 ymedi=c(2,i)+0.5d0*dyi
2303 zmedi=c(3,i)+0.5d0*dzi
2304 C Return atom into box, boxxsize is size of box in x dimension
2306 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2307 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2308 C Condition for being inside the proper box
2309 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2310 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2314 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2315 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2316 C Condition for being inside the proper box
2317 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2318 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2322 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2323 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2324 C Condition for being inside the proper box
2325 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2326 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2329 xmedi=mod(xmedi,boxxsize)
2330 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2331 ymedi=mod(ymedi,boxysize)
2332 if (ymedi.lt.0) ymedi=ymedi+boxysize
2333 zmedi=mod(zmedi,boxzsize)
2334 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2336 num_conti=num_cont_hb(i)
2338 c write(iout,*) "JESTEM W PETLI"
2339 call eelecij(i,i+3,ees,evdw1,eel_loc)
2340 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2341 & call eturn4(i,eello_turn4)
2343 num_cont_hb(i)=num_conti
2346 C Loop over all neighbouring boxes
2351 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2354 do i=iatel_s,iatel_e
2357 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2358 C changes suggested by Ana to avoid out of bounds
2359 c & .or.((i+2).gt.nres)
2360 c & .or.((i-1).le.0)
2361 C end of changes by Ana
2362 c & .or. itype(i+2).eq.ntyp1
2363 c & .or. itype(i-1).eq.ntyp1
2368 dx_normi=dc_norm(1,i)
2369 dy_normi=dc_norm(2,i)
2370 dz_normi=dc_norm(3,i)
2371 xmedi=c(1,i)+0.5d0*dxi
2372 ymedi=c(2,i)+0.5d0*dyi
2373 zmedi=c(3,i)+0.5d0*dzi
2374 xmedi=mod(xmedi,boxxsize)
2375 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2376 ymedi=mod(ymedi,boxysize)
2377 if (ymedi.lt.0) ymedi=ymedi+boxysize
2378 zmedi=mod(zmedi,boxzsize)
2379 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2380 C xmedi=xmedi+xshift*boxxsize
2381 C ymedi=ymedi+yshift*boxysize
2382 C zmedi=zmedi+zshift*boxzsize
2384 C Return tom into box, boxxsize is size of box in x dimension
2386 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2387 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2388 C Condition for being inside the proper box
2389 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2390 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2394 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2395 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2396 C Condition for being inside the proper box
2397 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2398 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2402 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2403 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2404 cC Condition for being inside the proper box
2405 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2406 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2410 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2412 num_conti=num_cont_hb(i)
2415 do j=ielstart(i),ielend(i)
2417 C write (iout,*) i,j
2419 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2420 C changes suggested by Ana to avoid out of bounds
2421 c & .or.((j+2).gt.nres)
2422 c & .or.((j-1).le.0)
2423 C end of changes by Ana
2424 c & .or.itype(j+2).eq.ntyp1
2425 c & .or.itype(j-1).eq.ntyp1
2427 call eelecij(i,j,ees,evdw1,eel_loc)
2430 num_cont_hb(i)=num_conti
2437 c write (iout,*) "Number of loop steps in EELEC:",ind
2439 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2440 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2442 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2443 ccc eel_loc=eel_loc+eello_turn3
2444 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2447 C-------------------------------------------------------------------------------
2448 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2449 implicit real*8 (a-h,o-z)
2450 include 'DIMENSIONS'
2451 include 'DIMENSIONS.ZSCOPT'
2455 include 'COMMON.CONTROL'
2456 include 'COMMON.IOUNITS'
2457 include 'COMMON.GEO'
2458 include 'COMMON.VAR'
2459 include 'COMMON.LOCAL'
2460 include 'COMMON.CHAIN'
2461 include 'COMMON.DERIV'
2462 include 'COMMON.INTERACT'
2464 include 'COMMON.CONTACTS'
2465 include 'COMMON.CONTMAT'
2467 include 'COMMON.CORRMAT'
2468 include 'COMMON.TORSION'
2469 include 'COMMON.VECTORS'
2470 include 'COMMON.FFIELD'
2471 include 'COMMON.TIME1'
2472 include 'COMMON.SPLITELE'
2473 include 'COMMON.SHIELD'
2474 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2475 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2476 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2477 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2478 & gmuij2(4),gmuji2(4)
2479 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2480 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2482 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2484 double precision scal_el /1.0d0/
2486 double precision scal_el /0.5d0/
2489 C 13-go grudnia roku pamietnego...
2490 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2491 & 0.0d0,1.0d0,0.0d0,
2492 & 0.0d0,0.0d0,1.0d0/
2493 integer xshift,yshift,zshift
2494 c time00=MPI_Wtime()
2495 cd write (iout,*) "eelecij",i,j
2499 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2500 aaa=app(iteli,itelj)
2501 bbb=bpp(iteli,itelj)
2502 ael6i=ael6(iteli,itelj)
2503 ael3i=ael3(iteli,itelj)
2507 dx_normj=dc_norm(1,j)
2508 dy_normj=dc_norm(2,j)
2509 dz_normj=dc_norm(3,j)
2510 C xj=c(1,j)+0.5D0*dxj-xmedi
2511 C yj=c(2,j)+0.5D0*dyj-ymedi
2512 C zj=c(3,j)+0.5D0*dzj-zmedi
2517 if (xj.lt.0) xj=xj+boxxsize
2519 if (yj.lt.0) yj=yj+boxysize
2521 if (zj.lt.0) zj=zj+boxzsize
2522 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2523 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2531 xj=xj_safe+xshift*boxxsize
2532 yj=yj_safe+yshift*boxysize
2533 zj=zj_safe+zshift*boxzsize
2534 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2535 if(dist_temp.lt.dist_init) then
2545 if (isubchap.eq.1) then
2554 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2556 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2557 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2558 C Condition for being inside the proper box
2559 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2560 c & (xj.lt.((-0.5d0)*boxxsize))) then
2564 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2565 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2566 C Condition for being inside the proper box
2567 c if ((yj.gt.((0.5d0)*boxysize)).or.
2568 c & (yj.lt.((-0.5d0)*boxysize))) then
2572 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2573 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2574 C Condition for being inside the proper box
2575 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2576 c & (zj.lt.((-0.5d0)*boxzsize))) then
2579 C endif !endPBC condintion
2583 rij=xj*xj+yj*yj+zj*zj
2585 sss=sscale(sqrt(rij))
2586 if (sss.eq.0.0d0) return
2587 sssgrad=sscagrad(sqrt(rij))
2588 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2589 c & " rlamb",rlamb," sss",sss
2590 c if (sss.gt.0.0d0) then
2596 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2597 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2598 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2599 fac=cosa-3.0D0*cosb*cosg
2601 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2602 if (j.eq.i+2) ev1=scal_el*ev1
2607 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2611 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2612 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2613 if (shield_mode.gt.0) then
2616 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2617 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2626 evdw1=evdw1+evdwij*sss
2627 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2628 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2629 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2630 cd & xmedi,ymedi,zmedi,xj,yj,zj
2632 if (energy_dec) then
2633 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2635 &,iteli,itelj,aaa,evdw1,sss
2636 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2637 &fac_shield(i),fac_shield(j)
2641 C Calculate contributions to the Cartesian gradient.
2644 facvdw=-6*rrmij*(ev1+evdwij)*sss
2645 facel=-3*rrmij*(el1+eesij)
2652 * Radial derivatives. First process both termini of the fragment (i,j)
2658 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2659 & (shield_mode.gt.0)) then
2661 do ilist=1,ishield_list(i)
2662 iresshield=shield_list(ilist,i)
2664 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2666 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2668 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2669 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2670 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2671 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2672 C if (iresshield.gt.i) then
2673 C do ishi=i+1,iresshield-1
2674 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2675 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2679 C do ishi=iresshield,i
2680 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2681 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2687 do ilist=1,ishield_list(j)
2688 iresshield=shield_list(ilist,j)
2690 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2692 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2694 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2695 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2697 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2698 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2699 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2700 C if (iresshield.gt.j) then
2701 C do ishi=j+1,iresshield-1
2702 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2703 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2707 C do ishi=iresshield,j
2708 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2709 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2716 gshieldc(k,i)=gshieldc(k,i)+
2717 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2718 gshieldc(k,j)=gshieldc(k,j)+
2719 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2720 gshieldc(k,i-1)=gshieldc(k,i-1)+
2721 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2722 gshieldc(k,j-1)=gshieldc(k,j-1)+
2723 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2728 c ghalf=0.5D0*ggg(k)
2729 c gelc(k,i)=gelc(k,i)+ghalf
2730 c gelc(k,j)=gelc(k,j)+ghalf
2732 c 9/28/08 AL Gradient compotents will be summed only at the end
2733 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2735 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2736 C & +grad_shield(k,j)*eesij/fac_shield(j)
2737 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2738 C & +grad_shield(k,i)*eesij/fac_shield(i)
2739 C gelc_long(k,i-1)=gelc_long(k,i-1)
2740 C & +grad_shield(k,i)*eesij/fac_shield(i)
2741 C gelc_long(k,j-1)=gelc_long(k,j-1)
2742 C & +grad_shield(k,j)*eesij/fac_shield(j)
2744 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2747 * Loop over residues i+1 thru j-1.
2751 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2754 if (sss.gt.0.0) then
2755 facvdw=facvdw+sssgrad*rmij*evdwij
2765 c ghalf=0.5D0*ggg(k)
2766 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2767 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2769 c 9/28/08 AL Gradient compotents will be summed only at the end
2771 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2772 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2775 * Loop over residues i+1 thru j-1.
2779 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2788 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2789 & +(evdwij+eesij)*sssgrad*rrmij
2794 * Radial derivatives. First process both termini of the fragment (i,j)
2798 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2800 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2802 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2804 c ghalf=0.5D0*ggg(k)
2805 c gelc(k,i)=gelc(k,i)+ghalf
2806 c gelc(k,j)=gelc(k,j)+ghalf
2808 c 9/28/08 AL Gradient compotents will be summed only at the end
2810 gelc_long(k,j)=gelc(k,j)+ggg(k)
2811 gelc_long(k,i)=gelc(k,i)-ggg(k)
2814 * Loop over residues i+1 thru j-1.
2818 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2821 c 9/28/08 AL Gradient compotents will be summed only at the end
2822 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2823 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2824 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2826 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2827 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2835 ecosa=2.0D0*fac3*fac1+fac4
2838 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2839 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2841 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2842 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2844 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2845 cd & (dcosg(k),k=1,3)
2847 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2848 & fac_shield(i)**2*fac_shield(j)**2
2851 c ghalf=0.5D0*ggg(k)
2852 c gelc(k,i)=gelc(k,i)+ghalf
2853 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2854 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2855 c gelc(k,j)=gelc(k,j)+ghalf
2856 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2857 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2861 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2864 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2867 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2868 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2869 & *fac_shield(i)**2*fac_shield(j)**2
2871 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2872 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2873 & *fac_shield(i)**2*fac_shield(j)**2
2874 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2875 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2877 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2882 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2883 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2884 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2886 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2887 C energy of a peptide unit is assumed in the form of a second-order
2888 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2889 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2890 C are computed for EVERY pair of non-contiguous peptide groups.
2893 if (j.lt.nres-1) then
2905 muij(kkk)=mu(k,i)*mu(l,j)
2906 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2909 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2910 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2911 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2912 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2913 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2914 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2920 write (iout,*) 'EELEC: i',i,' j',j
2921 write (iout,*) 'j',j,' j1',j1,' j2',j2
2922 write(iout,*) 'muij',muij
2923 write (iout,*) "uy",uy(:,i)
2924 write (iout,*) "uz",uz(:,j)
2925 write (iout,*) "erij",erij
2927 ury=scalar(uy(1,i),erij)
2928 urz=scalar(uz(1,i),erij)
2929 vry=scalar(uy(1,j),erij)
2930 vrz=scalar(uz(1,j),erij)
2931 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2932 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2933 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2934 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2935 fac=dsqrt(-ael6i)*r3ij
2940 cd write (iout,'(4i5,4f10.5)')
2941 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2942 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2943 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2944 cd & uy(:,j),uz(:,j)
2945 cd write (iout,'(4f10.5)')
2946 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2947 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2948 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2949 cd write (iout,'(9f10.5/)')
2950 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2951 C Derivatives of the elements of A in virtual-bond vectors
2953 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2955 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2956 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2957 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2958 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2959 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2960 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2961 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2962 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2963 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2964 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2965 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2966 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2968 C Compute radial contributions to the gradient
2986 C Add the contributions coming from er
2989 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2990 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2991 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2992 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2995 C Derivatives in DC(i)
2996 cgrad ghalf1=0.5d0*agg(k,1)
2997 cgrad ghalf2=0.5d0*agg(k,2)
2998 cgrad ghalf3=0.5d0*agg(k,3)
2999 cgrad ghalf4=0.5d0*agg(k,4)
3000 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3001 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3002 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3003 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3004 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3005 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3006 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3007 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3008 C Derivatives in DC(i+1)
3009 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3010 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3011 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3012 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3013 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3014 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3015 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3016 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3017 C Derivatives in DC(j)
3018 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3019 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3020 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3021 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3022 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3023 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3024 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3025 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3026 C Derivatives in DC(j+1) or DC(nres-1)
3027 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3028 & -3.0d0*vryg(k,3)*ury)
3029 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3030 & -3.0d0*vrzg(k,3)*ury)
3031 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3032 & -3.0d0*vryg(k,3)*urz)
3033 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3034 & -3.0d0*vrzg(k,3)*urz)
3035 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3037 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3052 aggi(k,l)=-aggi(k,l)
3053 aggi1(k,l)=-aggi1(k,l)
3054 aggj(k,l)=-aggj(k,l)
3055 aggj1(k,l)=-aggj1(k,l)
3059 if (j.lt.nres-1) then
3065 aggi(k,l)=-aggi(k,l)
3066 aggi1(k,l)=-aggi1(k,l)
3067 aggj(k,l)=-aggj(k,l)
3068 aggj1(k,l)=-aggj1(k,l)
3079 aggi(k,l)=-aggi(k,l)
3080 aggi1(k,l)=-aggi1(k,l)
3081 aggj(k,l)=-aggj(k,l)
3082 aggj1(k,l)=-aggj1(k,l)
3087 IF (wel_loc.gt.0.0d0) THEN
3088 C Contribution to the local-electrostatic energy coming from the i-j pair
3089 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3092 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
3094 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
3095 & " wel_loc",wel_loc
3097 if (shield_mode.eq.0) then
3104 eel_loc_ij=eel_loc_ij
3105 & *fac_shield(i)*fac_shield(j)*sss
3106 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3107 & 'eelloc',i,j,eel_loc_ij
3108 c if (eel_loc_ij.ne.0)
3109 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3110 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3112 eel_loc=eel_loc+eel_loc_ij
3113 C Now derivative over eel_loc
3115 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3116 & (shield_mode.gt.0)) then
3119 do ilist=1,ishield_list(i)
3120 iresshield=shield_list(ilist,i)
3122 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
3125 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3127 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
3128 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3132 do ilist=1,ishield_list(j)
3133 iresshield=shield_list(ilist,j)
3135 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
3138 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3140 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3141 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3148 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3149 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3150 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3151 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3152 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3153 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3154 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3155 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3160 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3161 c & ' eel_loc_ij',eel_loc_ij
3162 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3163 C Calculate patrial derivative for theta angle
3165 geel_loc_ij=(a22*gmuij1(1)
3169 & *fac_shield(i)*fac_shield(j)*sss
3170 c write(iout,*) "derivative over thatai"
3171 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3173 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3174 & geel_loc_ij*wel_loc
3175 c write(iout,*) "derivative over thatai-1"
3176 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3183 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3184 & geel_loc_ij*wel_loc
3185 & *fac_shield(i)*fac_shield(j)*sss
3187 c Derivative over j residue
3188 geel_loc_ji=a22*gmuji1(1)
3192 c write(iout,*) "derivative over thataj"
3193 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3196 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3197 & geel_loc_ji*wel_loc
3198 & *fac_shield(i)*fac_shield(j)
3205 c write(iout,*) "derivative over thataj-1"
3206 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3208 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3209 & geel_loc_ji*wel_loc
3210 & *fac_shield(i)*fac_shield(j)*sss
3212 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3214 C Partial derivatives in virtual-bond dihedral angles gamma
3216 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3217 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3218 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3219 & *fac_shield(i)*fac_shield(j)
3221 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3222 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3223 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3224 & *fac_shield(i)*fac_shield(j)
3225 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3226 aux=eel_loc_ij/sss*sssgrad*rmij
3231 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3232 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3233 & *fac_shield(i)*fac_shield(j)*sss
3234 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3235 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3236 cgrad ghalf=0.5d0*ggg(l)
3237 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3238 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3242 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3245 C Remaining derivatives of eello
3247 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3248 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3249 & *fac_shield(i)*fac_shield(j)
3251 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3252 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3253 & *fac_shield(i)*fac_shield(j)
3255 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3256 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3257 & *fac_shield(i)*fac_shield(j)
3259 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3260 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3261 & *fac_shield(i)*fac_shield(j)
3268 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3269 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3271 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3272 & .and. num_conti.le.maxconts) then
3273 c write (iout,*) i,j," entered corr"
3275 C Calculate the contact function. The ith column of the array JCONT will
3276 C contain the numbers of atoms that make contacts with the atom I (of numbers
3277 C greater than I). The arrays FACONT and GACONT will contain the values of
3278 C the contact function and its derivative.
3279 c r0ij=1.02D0*rpp(iteli,itelj)
3280 c r0ij=1.11D0*rpp(iteli,itelj)
3281 r0ij=2.20D0*rpp(iteli,itelj)
3282 c r0ij=1.55D0*rpp(iteli,itelj)
3283 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3284 if (fcont.gt.0.0D0) then
3285 num_conti=num_conti+1
3286 if (num_conti.gt.maxconts) then
3287 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3288 & ' will skip next contacts for this conf.'
3290 jcont_hb(num_conti,i)=j
3291 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3292 cd & " jcont_hb",jcont_hb(num_conti,i)
3293 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3294 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3295 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3297 d_cont(num_conti,i)=rij
3298 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3299 C --- Electrostatic-interaction matrix ---
3300 a_chuj(1,1,num_conti,i)=a22
3301 a_chuj(1,2,num_conti,i)=a23
3302 a_chuj(2,1,num_conti,i)=a32
3303 a_chuj(2,2,num_conti,i)=a33
3304 C --- Gradient of rij
3307 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3314 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3315 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3316 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3317 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3318 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3324 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3325 C Calculate contact energies
3327 wij=cosa-3.0D0*cosb*cosg
3330 c fac3=dsqrt(-ael6i)/r0ij**3
3331 fac3=dsqrt(-ael6i)*r3ij
3332 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3333 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3334 if (ees0tmp.gt.0) then
3335 ees0pij=dsqrt(ees0tmp)
3339 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3340 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3341 if (ees0tmp.gt.0) then
3342 ees0mij=dsqrt(ees0tmp)
3347 if (shield_mode.eq.0) then
3351 ees0plist(num_conti,i)=j
3352 C fac_shield(i)=0.4d0
3353 C fac_shield(j)=0.6d0
3355 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3356 & *fac_shield(i)*fac_shield(j)
3357 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3358 & *fac_shield(i)*fac_shield(j)
3359 C Diagnostics. Comment out or remove after debugging!
3360 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3361 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3362 c ees0m(num_conti,i)=0.0D0
3364 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3365 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3366 C Angular derivatives of the contact function
3368 ees0pij1=fac3/ees0pij
3369 ees0mij1=fac3/ees0mij
3370 fac3p=-3.0D0*fac3*rrmij
3371 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3372 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3374 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3375 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3376 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3377 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3378 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3379 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3380 ecosap=ecosa1+ecosa2
3381 ecosbp=ecosb1+ecosb2
3382 ecosgp=ecosg1+ecosg2
3383 ecosam=ecosa1-ecosa2
3384 ecosbm=ecosb1-ecosb2
3385 ecosgm=ecosg1-ecosg2
3394 facont_hb(num_conti,i)=fcont
3397 fprimcont=fprimcont/rij
3398 cd facont_hb(num_conti,i)=1.0D0
3399 C Following line is for diagnostics.
3402 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3403 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3406 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3407 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3409 gggp(1)=gggp(1)+ees0pijp*xj
3410 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3411 gggp(2)=gggp(2)+ees0pijp*yj
3412 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3413 gggp(3)=gggp(3)+ees0pijp*zj
3414 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3415 gggm(1)=gggm(1)+ees0mijp*xj
3416 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3417 gggm(2)=gggm(2)+ees0mijp*yj
3418 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3419 gggm(3)=gggm(3)+ees0mijp*zj
3420 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3421 C Derivatives due to the contact function
3422 gacont_hbr(1,num_conti,i)=fprimcont*xj
3423 gacont_hbr(2,num_conti,i)=fprimcont*yj
3424 gacont_hbr(3,num_conti,i)=fprimcont*zj
3427 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3428 c following the change of gradient-summation algorithm.
3430 cgrad ghalfp=0.5D0*gggp(k)
3431 cgrad ghalfm=0.5D0*gggm(k)
3432 gacontp_hb1(k,num_conti,i)=!ghalfp
3433 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3434 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3435 & *fac_shield(i)*fac_shield(j)*sss
3437 gacontp_hb2(k,num_conti,i)=!ghalfp
3438 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3439 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3440 & *fac_shield(i)*fac_shield(j)*sss
3442 gacontp_hb3(k,num_conti,i)=gggp(k)
3443 & *fac_shield(i)*fac_shield(j)*sss
3445 gacontm_hb1(k,num_conti,i)=!ghalfm
3446 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3447 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3448 & *fac_shield(i)*fac_shield(j)*sss
3450 gacontm_hb2(k,num_conti,i)=!ghalfm
3451 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3452 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3453 & *fac_shield(i)*fac_shield(j)*sss
3455 gacontm_hb3(k,num_conti,i)=gggm(k)
3456 & *fac_shield(i)*fac_shield(j)*sss
3459 C Diagnostics. Comment out or remove after debugging!
3461 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3462 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3463 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3464 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3465 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3466 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3472 endif ! num_conti.le.maxconts
3477 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3480 ghalf=0.5d0*agg(l,k)
3481 aggi(l,k)=aggi(l,k)+ghalf
3482 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3483 aggj(l,k)=aggj(l,k)+ghalf
3486 if (j.eq.nres-1 .and. i.lt.j-2) then
3489 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3495 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3498 C-----------------------------------------------------------------------------
3499 subroutine eturn3(i,eello_turn3)
3500 C Third- and fourth-order contributions from turns
3501 implicit real*8 (a-h,o-z)
3502 include 'DIMENSIONS'
3503 include 'DIMENSIONS.ZSCOPT'
3504 include 'COMMON.IOUNITS'
3505 include 'COMMON.GEO'
3506 include 'COMMON.VAR'
3507 include 'COMMON.LOCAL'
3508 include 'COMMON.CHAIN'
3509 include 'COMMON.DERIV'
3510 include 'COMMON.INTERACT'
3511 include 'COMMON.CONTACTS'
3512 include 'COMMON.TORSION'
3513 include 'COMMON.VECTORS'
3514 include 'COMMON.FFIELD'
3515 include 'COMMON.CONTROL'
3516 include 'COMMON.SHIELD'
3517 include 'COMMON.CORRMAT'
3519 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3520 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3521 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3522 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3523 & auxgmat2(2,2),auxgmatt2(2,2)
3524 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3525 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3526 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3527 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3530 c write (iout,*) "eturn3",i,j,j1,j2
3535 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3537 C Third-order contributions
3544 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3545 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3546 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3547 c auxalary matices for theta gradient
3548 c auxalary matrix for i+1 and constant i+2
3549 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3550 c auxalary matrix for i+2 and constant i+1
3551 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3552 call transpose2(auxmat(1,1),auxmat1(1,1))
3553 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3554 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3555 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3556 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3557 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3558 if (shield_mode.eq.0) then
3565 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3566 & *fac_shield(i)*fac_shield(j)
3567 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3568 & *fac_shield(i)*fac_shield(j)
3569 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3573 C Derivatives in theta
3574 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3575 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3576 & *fac_shield(i)*fac_shield(j)
3577 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3578 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3579 & *fac_shield(i)*fac_shield(j)
3582 C Derivatives in shield mode
3583 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3584 & (shield_mode.gt.0)) then
3587 do ilist=1,ishield_list(i)
3588 iresshield=shield_list(ilist,i)
3590 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3592 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3594 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3595 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3599 do ilist=1,ishield_list(j)
3600 iresshield=shield_list(ilist,j)
3602 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3604 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3606 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3607 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3614 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3615 & grad_shield(k,i)*eello_t3/fac_shield(i)
3616 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3617 & grad_shield(k,j)*eello_t3/fac_shield(j)
3618 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3619 & grad_shield(k,i)*eello_t3/fac_shield(i)
3620 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3621 & grad_shield(k,j)*eello_t3/fac_shield(j)
3625 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3626 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3627 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3628 cd & ' eello_turn3_num',4*eello_turn3_num
3629 C Derivatives in gamma(i)
3630 call matmat2(EUgder(1,1,i+1),EUg(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)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3634 & *fac_shield(i)*fac_shield(j)
3635 C Derivatives in gamma(i+1)
3636 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3637 call transpose2(auxmat2(1,1),auxmat3(1,1))
3638 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3639 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3640 & +0.5d0*(pizda(1,1)+pizda(2,2))
3641 & *fac_shield(i)*fac_shield(j)
3642 C Cartesian derivatives
3644 c ghalf1=0.5d0*agg(l,1)
3645 c ghalf2=0.5d0*agg(l,2)
3646 c ghalf3=0.5d0*agg(l,3)
3647 c ghalf4=0.5d0*agg(l,4)
3648 a_temp(1,1)=aggi(l,1)!+ghalf1
3649 a_temp(1,2)=aggi(l,2)!+ghalf2
3650 a_temp(2,1)=aggi(l,3)!+ghalf3
3651 a_temp(2,2)=aggi(l,4)!+ghalf4
3652 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3653 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3654 & +0.5d0*(pizda(1,1)+pizda(2,2))
3655 & *fac_shield(i)*fac_shield(j)
3657 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3658 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3659 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3660 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3661 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3662 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3663 & +0.5d0*(pizda(1,1)+pizda(2,2))
3664 & *fac_shield(i)*fac_shield(j)
3665 a_temp(1,1)=aggj(l,1)!+ghalf1
3666 a_temp(1,2)=aggj(l,2)!+ghalf2
3667 a_temp(2,1)=aggj(l,3)!+ghalf3
3668 a_temp(2,2)=aggj(l,4)!+ghalf4
3669 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3670 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3671 & +0.5d0*(pizda(1,1)+pizda(2,2))
3672 & *fac_shield(i)*fac_shield(j)
3673 a_temp(1,1)=aggj1(l,1)
3674 a_temp(1,2)=aggj1(l,2)
3675 a_temp(2,1)=aggj1(l,3)
3676 a_temp(2,2)=aggj1(l,4)
3677 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3678 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3679 & +0.5d0*(pizda(1,1)+pizda(2,2))
3680 & *fac_shield(i)*fac_shield(j)
3687 C-------------------------------------------------------------------------------
3688 subroutine eturn4(i,eello_turn4)
3689 C Third- and fourth-order contributions from turns
3690 implicit real*8 (a-h,o-z)
3691 include 'DIMENSIONS'
3692 include 'DIMENSIONS.ZSCOPT'
3693 include 'COMMON.IOUNITS'
3694 include 'COMMON.GEO'
3695 include 'COMMON.VAR'
3696 include 'COMMON.LOCAL'
3697 include 'COMMON.CHAIN'
3698 include 'COMMON.DERIV'
3699 include 'COMMON.INTERACT'
3700 include 'COMMON.CONTACTS'
3701 include 'COMMON.TORSION'
3702 include 'COMMON.VECTORS'
3703 include 'COMMON.FFIELD'
3704 include 'COMMON.CONTROL'
3705 include 'COMMON.SHIELD'
3706 include 'COMMON.CORRMAT'
3708 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3709 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3710 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3711 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3712 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3713 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3714 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3715 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3716 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3717 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3718 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3721 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3723 C Fourth-order contributions
3731 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3732 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3733 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3734 c write(iout,*)"WCHODZE W PROGRAM"
3739 iti1=itype2loc(itype(i+1))
3740 iti2=itype2loc(itype(i+2))
3741 iti3=itype2loc(itype(i+3))
3742 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3743 call transpose2(EUg(1,1,i+1),e1t(1,1))
3744 call transpose2(Eug(1,1,i+2),e2t(1,1))
3745 call transpose2(Eug(1,1,i+3),e3t(1,1))
3746 C Ematrix derivative in theta
3747 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3748 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3749 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3750 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3751 c eta1 in derivative theta
3752 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3753 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3754 c auxgvec is derivative of Ub2 so i+3 theta
3755 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3756 c auxalary matrix of E i+1
3757 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3760 s1=scalar2(b1(1,i+2),auxvec(1))
3761 c derivative of theta i+2 with constant i+3
3762 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3763 c derivative of theta i+2 with constant i+2
3764 gs32=scalar2(b1(1,i+2),auxgvec(1))
3765 c derivative of E matix in theta of i+1
3766 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3768 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3769 c ea31 in derivative theta
3770 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3771 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3772 c auxilary matrix auxgvec of Ub2 with constant E matirx
3773 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3774 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3775 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3779 s2=scalar2(b1(1,i+1),auxvec(1))
3780 c derivative of theta i+1 with constant i+3
3781 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3782 c derivative of theta i+2 with constant i+1
3783 gs21=scalar2(b1(1,i+1),auxgvec(1))
3784 c derivative of theta i+3 with constant i+1
3785 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3786 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3788 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3789 c two derivatives over diffetent matrices
3790 c gtae3e2 is derivative over i+3
3791 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3792 c ae3gte2 is derivative over i+2
3793 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3794 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3795 c three possible derivative over theta E matices
3797 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3799 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3801 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3802 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3804 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3805 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3806 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3807 if (shield_mode.eq.0) then
3814 eello_turn4=eello_turn4-(s1+s2+s3)
3815 & *fac_shield(i)*fac_shield(j)
3816 eello_t4=-(s1+s2+s3)
3817 & *fac_shield(i)*fac_shield(j)
3818 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3819 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3820 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3821 C Now derivative over shield:
3822 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3823 & (shield_mode.gt.0)) then
3826 do ilist=1,ishield_list(i)
3827 iresshield=shield_list(ilist,i)
3829 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3831 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3833 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3834 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3838 do ilist=1,ishield_list(j)
3839 iresshield=shield_list(ilist,j)
3841 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3843 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3845 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3846 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3853 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3854 & grad_shield(k,i)*eello_t4/fac_shield(i)
3855 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3856 & grad_shield(k,j)*eello_t4/fac_shield(j)
3857 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3858 & grad_shield(k,i)*eello_t4/fac_shield(i)
3859 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3860 & grad_shield(k,j)*eello_t4/fac_shield(j)
3863 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3864 cd & ' eello_turn4_num',8*eello_turn4_num
3866 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3867 & -(gs13+gsE13+gsEE1)*wturn4
3868 & *fac_shield(i)*fac_shield(j)
3869 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3870 & -(gs23+gs21+gsEE2)*wturn4
3871 & *fac_shield(i)*fac_shield(j)
3873 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3874 & -(gs32+gsE31+gsEE3)*wturn4
3875 & *fac_shield(i)*fac_shield(j)
3877 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3880 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3881 & 'eturn4',i,j,-(s1+s2+s3)
3882 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3883 c & ' eello_turn4_num',8*eello_turn4_num
3884 C Derivatives in gamma(i)
3885 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3886 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3887 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3888 s1=scalar2(b1(1,i+2),auxvec(1))
3889 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3890 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3891 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3892 & *fac_shield(i)*fac_shield(j)
3893 C Derivatives in gamma(i+1)
3894 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3895 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3896 s2=scalar2(b1(1,i+1),auxvec(1))
3897 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3898 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3899 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3900 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3901 & *fac_shield(i)*fac_shield(j)
3902 C Derivatives in gamma(i+2)
3903 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3904 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3905 s1=scalar2(b1(1,i+2),auxvec(1))
3906 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3907 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3908 s2=scalar2(b1(1,i+1),auxvec(1))
3909 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3910 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3911 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3912 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3913 & *fac_shield(i)*fac_shield(j)
3915 C Cartesian derivatives
3916 C Derivatives of this turn contributions in DC(i+2)
3917 if (j.lt.nres-1) then
3919 a_temp(1,1)=agg(l,1)
3920 a_temp(1,2)=agg(l,2)
3921 a_temp(2,1)=agg(l,3)
3922 a_temp(2,2)=agg(l,4)
3923 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3924 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3925 s1=scalar2(b1(1,i+2),auxvec(1))
3926 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3927 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3928 s2=scalar2(b1(1,i+1),auxvec(1))
3929 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3930 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3931 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3933 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3934 & *fac_shield(i)*fac_shield(j)
3937 C Remaining derivatives of this turn contribution
3939 a_temp(1,1)=aggi(l,1)
3940 a_temp(1,2)=aggi(l,2)
3941 a_temp(2,1)=aggi(l,3)
3942 a_temp(2,2)=aggi(l,4)
3943 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3944 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3945 s1=scalar2(b1(1,i+2),auxvec(1))
3946 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3947 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3948 s2=scalar2(b1(1,i+1),auxvec(1))
3949 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3950 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3951 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3952 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3953 & *fac_shield(i)*fac_shield(j)
3954 a_temp(1,1)=aggi1(l,1)
3955 a_temp(1,2)=aggi1(l,2)
3956 a_temp(2,1)=aggi1(l,3)
3957 a_temp(2,2)=aggi1(l,4)
3958 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3959 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3960 s1=scalar2(b1(1,i+2),auxvec(1))
3961 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3962 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3963 s2=scalar2(b1(1,i+1),auxvec(1))
3964 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3965 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3966 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3967 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3968 & *fac_shield(i)*fac_shield(j)
3969 a_temp(1,1)=aggj(l,1)
3970 a_temp(1,2)=aggj(l,2)
3971 a_temp(2,1)=aggj(l,3)
3972 a_temp(2,2)=aggj(l,4)
3973 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3974 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3975 s1=scalar2(b1(1,i+2),auxvec(1))
3976 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3977 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3978 s2=scalar2(b1(1,i+1),auxvec(1))
3979 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3980 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3981 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3982 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3983 & *fac_shield(i)*fac_shield(j)
3984 a_temp(1,1)=aggj1(l,1)
3985 a_temp(1,2)=aggj1(l,2)
3986 a_temp(2,1)=aggj1(l,3)
3987 a_temp(2,2)=aggj1(l,4)
3988 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3989 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3990 s1=scalar2(b1(1,i+2),auxvec(1))
3991 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3992 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3993 s2=scalar2(b1(1,i+1),auxvec(1))
3994 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3995 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3996 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3997 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3998 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3999 & *fac_shield(i)*fac_shield(j)
4006 C-----------------------------------------------------------------------------
4007 subroutine vecpr(u,v,w)
4008 implicit real*8(a-h,o-z)
4009 dimension u(3),v(3),w(3)
4010 w(1)=u(2)*v(3)-u(3)*v(2)
4011 w(2)=-u(1)*v(3)+u(3)*v(1)
4012 w(3)=u(1)*v(2)-u(2)*v(1)
4015 C-----------------------------------------------------------------------------
4016 subroutine unormderiv(u,ugrad,unorm,ungrad)
4017 C This subroutine computes the derivatives of a normalized vector u, given
4018 C the derivatives computed without normalization conditions, ugrad. Returns
4021 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4022 double precision vec(3)
4023 double precision scalar
4025 c write (2,*) 'ugrad',ugrad
4028 vec(i)=scalar(ugrad(1,i),u(1))
4030 c write (2,*) 'vec',vec
4033 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4036 c write (2,*) 'ungrad',ungrad
4039 C-----------------------------------------------------------------------------
4040 subroutine escp(evdw2,evdw2_14)
4042 C This subroutine calculates the excluded-volume interaction energy between
4043 C peptide-group centers and side chains and its gradient in virtual-bond and
4044 C side-chain vectors.
4046 implicit real*8 (a-h,o-z)
4047 include 'DIMENSIONS'
4048 include 'DIMENSIONS.ZSCOPT'
4049 include 'COMMON.CONTROL'
4050 include 'COMMON.GEO'
4051 include 'COMMON.VAR'
4052 include 'COMMON.LOCAL'
4053 include 'COMMON.CHAIN'
4054 include 'COMMON.DERIV'
4055 include 'COMMON.INTERACT'
4056 include 'COMMON.FFIELD'
4057 include 'COMMON.IOUNITS'
4061 cd print '(a)','Enter ESCP'
4062 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4063 c & ' scal14',scal14
4064 do i=iatscp_s,iatscp_e
4065 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4067 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4068 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4069 if (iteli.eq.0) goto 1225
4070 xi=0.5D0*(c(1,i)+c(1,i+1))
4071 yi=0.5D0*(c(2,i)+c(2,i+1))
4072 zi=0.5D0*(c(3,i)+c(3,i+1))
4073 C Returning the ith atom to box
4075 if (xi.lt.0) xi=xi+boxxsize
4077 if (yi.lt.0) yi=yi+boxysize
4079 if (zi.lt.0) zi=zi+boxzsize
4080 do iint=1,nscp_gr(i)
4082 do j=iscpstart(i,iint),iscpend(i,iint)
4083 itypj=iabs(itype(j))
4084 if (itypj.eq.ntyp1) cycle
4085 C Uncomment following three lines for SC-p interactions
4089 C Uncomment following three lines for Ca-p interactions
4093 C returning the jth atom to box
4095 if (xj.lt.0) xj=xj+boxxsize
4097 if (yj.lt.0) yj=yj+boxysize
4099 if (zj.lt.0) zj=zj+boxzsize
4100 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4105 C Finding the closest jth atom
4109 xj=xj_safe+xshift*boxxsize
4110 yj=yj_safe+yshift*boxysize
4111 zj=zj_safe+zshift*boxzsize
4112 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4113 if(dist_temp.lt.dist_init) then
4123 if (subchap.eq.1) then
4132 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4133 C sss is scaling function for smoothing the cutoff gradient otherwise
4134 C the gradient would not be continuouse
4135 sss=sscale(1.0d0/(dsqrt(rrij)))
4136 if (sss.le.0.0d0) cycle
4137 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4139 e1=fac*fac*aad(itypj,iteli)
4140 e2=fac*bad(itypj,iteli)
4141 if (iabs(j-i) .le. 2) then
4144 evdw2_14=evdw2_14+(e1+e2)*sss
4147 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4148 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4149 c & bad(itypj,iteli)
4150 evdw2=evdw2+evdwij*sss
4151 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4152 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4157 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4159 fac=-(evdwij+e1)*rrij*sss
4160 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4165 cd write (iout,*) 'j<i'
4166 C Uncomment following three lines for SC-p interactions
4168 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4171 cd write (iout,*) 'j>i'
4174 C Uncomment following line for SC-p interactions
4175 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4179 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4183 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4184 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4187 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4197 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4198 gradx_scp(j,i)=expon*gradx_scp(j,i)
4201 C******************************************************************************
4205 C To save time the factor EXPON has been extracted from ALL components
4206 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4209 C******************************************************************************
4212 C--------------------------------------------------------------------------
4213 subroutine edis(ehpb)
4215 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4217 implicit real*8 (a-h,o-z)
4218 include 'DIMENSIONS'
4219 include 'DIMENSIONS.ZSCOPT'
4220 include 'COMMON.SBRIDGE'
4221 include 'COMMON.CHAIN'
4222 include 'COMMON.DERIV'
4223 include 'COMMON.VAR'
4224 include 'COMMON.INTERACT'
4225 include 'COMMON.CONTROL'
4226 include 'COMMON.IOUNITS'
4227 dimension ggg(3),ggg_peak(3,1000)
4232 c 8/21/18 AL: added explicit restraints on reference coords
4233 c write (iout,*) "restr_on_coord",restr_on_coord
4234 if (restr_on_coord) then
4238 if (itype(i).eq.ntyp1) cycle
4240 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4241 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4243 if (itype(i).ne.10) then
4245 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4246 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4249 if (energy_dec) write (iout,*)
4250 & "i",i," bfac",bfac(i)," ecoor",ecoor
4251 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4256 C write (iout,*) ,"link_end",link_end,constr_dist
4257 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4258 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4259 c & " constr_dist",constr_dist
4260 if (link_end.eq.0.and.link_end_peak.eq.0) return
4261 do i=link_start_peak,link_end_peak
4263 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4264 c & ipeak(1,i),ipeak(2,i)
4265 do ip=ipeak(1,i),ipeak(2,i)
4270 C iii and jjj point to the residues for which the distance is assigned.
4271 c if (ii.gt.nres) then
4278 if (ii.gt.nres) then
4283 if (jj.gt.nres) then
4288 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4289 aux=dexp(-scal_peak*aux)
4290 ehpb_peak=ehpb_peak+aux
4291 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4292 & forcon_peak(ip))*aux/dd
4294 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4296 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4297 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4298 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4300 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4301 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4302 do ip=ipeak(1,i),ipeak(2,i)
4305 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4309 C iii and jjj point to the residues for which the distance is assigned.
4310 if (ii.gt.nres) then
4319 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4324 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4328 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4329 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4333 do i=link_start,link_end
4334 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4335 C CA-CA distance used in regularization of structure.
4338 C iii and jjj point to the residues for which the distance is assigned.
4339 if (ii.gt.nres) then
4344 if (jj.gt.nres) then
4349 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4350 c & dhpb(i),dhpb1(i),forcon(i)
4351 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4352 C distance and angle dependent SS bond potential.
4353 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4354 C & iabs(itype(jjj)).eq.1) then
4355 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4356 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4357 if (.not.dyn_ss .and. i.le.nss) then
4358 C 15/02/13 CC dynamic SSbond - additional check
4359 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4360 & iabs(itype(jjj)).eq.1) then
4361 call ssbond_ene(iii,jjj,eij)
4364 cd write (iout,*) "eij",eij
4365 cd & ' waga=',waga,' fac=',fac
4366 ! else if (ii.gt.nres .and. jj.gt.nres) then
4368 C Calculate the distance between the two points and its difference from the
4371 if (irestr_type(i).eq.11) then
4372 ehpb=ehpb+fordepth(i)!**4.0d0
4373 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4374 fac=fordepth(i)!**4.0d0
4375 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4376 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4377 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4378 & ehpb,irestr_type(i)
4379 else if (irestr_type(i).eq.10) then
4380 c AL 6//19/2018 cross-link restraints
4381 xdis = 0.5d0*(dd/forcon(i))**2
4382 expdis = dexp(-xdis)
4383 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4384 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4385 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4386 c & " wboltzd",wboltzd
4387 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4388 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4389 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4390 & *expdis/(aux*forcon(i)**2)
4391 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4392 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4393 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4394 else if (irestr_type(i).eq.2) then
4395 c Quartic restraints
4396 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4397 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4398 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4399 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4400 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4402 c Quadratic restraints
4404 C Get the force constant corresponding to this distance.
4406 C Calculate the contribution to energy.
4407 ehpb=ehpb+0.5d0*waga*rdis*rdis
4408 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4409 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4410 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4412 C Evaluate gradient.
4416 c Calculate Cartesian gradient
4418 ggg(j)=fac*(c(j,jj)-c(j,ii))
4420 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4421 C If this is a SC-SC distance, we need to calculate the contributions to the
4422 C Cartesian gradient in the SC vectors (ghpbx).
4425 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4430 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4434 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4435 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4441 C--------------------------------------------------------------------------
4442 subroutine ssbond_ene(i,j,eij)
4444 C Calculate the distance and angle dependent SS-bond potential energy
4445 C using a free-energy function derived based on RHF/6-31G** ab initio
4446 C calculations of diethyl disulfide.
4448 C A. Liwo and U. Kozlowska, 11/24/03
4450 implicit real*8 (a-h,o-z)
4451 include 'DIMENSIONS'
4452 include 'DIMENSIONS.ZSCOPT'
4453 include 'COMMON.SBRIDGE'
4454 include 'COMMON.CHAIN'
4455 include 'COMMON.DERIV'
4456 include 'COMMON.LOCAL'
4457 include 'COMMON.INTERACT'
4458 include 'COMMON.VAR'
4459 include 'COMMON.IOUNITS'
4460 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4461 itypi=iabs(itype(i))
4465 dxi=dc_norm(1,nres+i)
4466 dyi=dc_norm(2,nres+i)
4467 dzi=dc_norm(3,nres+i)
4468 dsci_inv=dsc_inv(itypi)
4469 itypj=iabs(itype(j))
4470 dscj_inv=dsc_inv(itypj)
4474 dxj=dc_norm(1,nres+j)
4475 dyj=dc_norm(2,nres+j)
4476 dzj=dc_norm(3,nres+j)
4477 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4482 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4483 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4484 om12=dxi*dxj+dyi*dyj+dzi*dzj
4486 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4487 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4493 deltat12=om2-om1+2.0d0
4495 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4496 & +akct*deltad*deltat12
4497 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4498 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4499 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4500 c & " deltat12",deltat12," eij",eij
4501 ed=2*akcm*deltad+akct*deltat12
4503 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4504 eom1=-2*akth*deltat1-pom1-om2*pom2
4505 eom2= 2*akth*deltat2+pom1-om1*pom2
4508 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4511 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4512 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4513 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4514 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4517 C Calculate the components of the gradient in DC and X
4521 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4526 C--------------------------------------------------------------------------
4527 c MODELLER restraint function
4528 subroutine e_modeller(ehomology_constr)
4529 implicit real*8 (a-h,o-z)
4530 include 'DIMENSIONS'
4531 include 'DIMENSIONS.ZSCOPT'
4532 include 'DIMENSIONS.FREE'
4533 integer nnn, i, j, k, ki, irec, l
4534 integer katy, odleglosci, test7
4535 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
4536 real*8 distance(max_template),distancek(max_template),
4537 & min_odl,godl(max_template),dih_diff(max_template)
4540 c FP - 30/10/2014 Temporary specifications for homology restraints
4542 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
4544 double precision, dimension (maxres) :: guscdiff,usc_diff
4545 double precision, dimension (max_template) ::
4546 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
4549 include 'COMMON.SBRIDGE'
4550 include 'COMMON.CHAIN'
4551 include 'COMMON.GEO'
4552 include 'COMMON.DERIV'
4553 include 'COMMON.LOCAL'
4554 include 'COMMON.INTERACT'
4555 include 'COMMON.VAR'
4556 include 'COMMON.IOUNITS'
4557 include 'COMMON.CONTROL'
4558 include 'COMMON.HOMRESTR'
4559 include 'COMMON.HOMOLOGY'
4560 include 'COMMON.SETUP'
4561 include 'COMMON.NAMES'
4564 distancek(i)=9999999.9
4569 c Pseudo-energy and gradient from homology restraints (MODELLER-like
4571 C AL 5/2/14 - Introduce list of restraints
4572 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
4574 write(iout,*) "------- dist restrs start -------"
4576 do ii = link_start_homo,link_end_homo
4580 c write (iout,*) "dij(",i,j,") =",dij
4582 do k=1,constr_homology
4583 if(.not.l_homo(k,ii)) then
4587 distance(k)=odl(k,ii)-dij
4588 c write (iout,*) "distance(",k,") =",distance(k)
4590 c For Gaussian-type Urestr
4592 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
4593 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
4594 c write (iout,*) "distancek(",k,") =",distancek(k)
4595 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
4597 c For Lorentzian-type Urestr
4599 if (waga_dist.lt.0.0d0) then
4600 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
4601 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
4602 & (distance(k)**2+sigma_odlir(k,ii)**2))
4606 c min_odl=minval(distancek)
4607 do kk=1,constr_homology
4608 if(l_homo(kk,ii)) then
4609 min_odl=distancek(kk)
4613 do kk=1,constr_homology
4614 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
4615 & min_odl=distancek(kk)
4617 c write (iout,* )"min_odl",min_odl
4619 write (iout,*) "ij dij",i,j,dij
4620 write (iout,*) "distance",(distance(k),k=1,constr_homology)
4621 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
4622 write (iout,* )"min_odl",min_odl
4627 if (waga_dist.ge.0.0d0) then
4633 do k=1,constr_homology
4634 c Nie wiem po co to liczycie jeszcze raz!
4635 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
4636 c & (2*(sigma_odl(i,j,k))**2))
4637 if(.not.l_homo(k,ii)) cycle
4638 if (waga_dist.ge.0.0d0) then
4640 c For Gaussian-type Urestr
4642 godl(k)=dexp(-distancek(k)+min_odl)
4643 odleg2=odleg2+godl(k)
4645 c For Lorentzian-type Urestr
4648 odleg2=odleg2+distancek(k)
4651 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
4652 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
4653 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
4654 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
4657 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4658 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4660 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4661 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4663 if (waga_dist.ge.0.0d0) then
4665 c For Gaussian-type Urestr
4667 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
4669 c For Lorentzian-type Urestr
4672 odleg=odleg+odleg2/constr_homology
4676 c write (iout,*) "odleg",odleg ! sum of -ln-s
4679 c For Gaussian-type Urestr
4681 if (waga_dist.ge.0.0d0) sum_godl=odleg2
4683 do k=1,constr_homology
4684 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4685 c & *waga_dist)+min_odl
4686 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
4688 if(.not.l_homo(k,ii)) cycle
4689 if (waga_dist.ge.0.0d0) then
4690 c For Gaussian-type Urestr
4692 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
4694 c For Lorentzian-type Urestr
4697 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
4698 & sigma_odlir(k,ii)**2)**2)
4700 sum_sgodl=sum_sgodl+sgodl
4702 c sgodl2=sgodl2+sgodl
4703 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
4704 c write(iout,*) "constr_homology=",constr_homology
4705 c write(iout,*) i, j, k, "TEST K"
4707 if (waga_dist.ge.0.0d0) then
4709 c For Gaussian-type Urestr
4711 grad_odl3=waga_homology(iset)*waga_dist
4712 & *sum_sgodl/(sum_godl*dij)
4714 c For Lorentzian-type Urestr
4717 c Original grad expr modified by analogy w Gaussian-type Urestr grad
4718 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
4719 grad_odl3=-waga_homology(iset)*waga_dist*
4720 & sum_sgodl/(constr_homology*dij)
4723 c grad_odl3=sum_sgodl/(sum_godl*dij)
4726 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
4727 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
4728 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4730 ccc write(iout,*) godl, sgodl, grad_odl3
4732 c grad_odl=grad_odl+grad_odl3
4735 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
4736 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
4737 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
4738 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4739 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
4740 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
4741 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
4742 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4743 c if (i.eq.25.and.j.eq.27) then
4744 c write(iout,*) "jik",jik,"i",i,"j",j
4745 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
4746 c write(iout,*) "grad_odl3",grad_odl3
4747 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
4748 c write(iout,*) "ggodl",ggodl
4749 c write(iout,*) "ghpbc(",jik,i,")",
4750 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
4755 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
4756 ccc & dLOG(odleg2),"-odleg=", -odleg
4758 enddo ! ii-loop for dist
4760 write(iout,*) "------- dist restrs end -------"
4761 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
4762 c & waga_d.eq.1.0d0) call sum_gradient
4764 c Pseudo-energy and gradient from dihedral-angle restraints from
4765 c homology templates
4766 c write (iout,*) "End of distance loop"
4769 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
4771 write(iout,*) "------- dih restrs start -------"
4772 do i=idihconstr_start_homo,idihconstr_end_homo
4773 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
4776 do i=idihconstr_start_homo,idihconstr_end_homo
4778 c betai=beta(i,i+1,i+2,i+3)
4780 c write (iout,*) "betai =",betai
4781 do k=1,constr_homology
4782 dih_diff(k)=pinorm(dih(k,i)-betai)
4783 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
4784 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
4785 c & -(6.28318-dih_diff(i,k))
4786 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
4787 c & 6.28318+dih_diff(i,k)
4789 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
4791 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
4793 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
4796 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
4799 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
4800 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
4802 write (iout,*) "i",i," betai",betai," kat2",kat2
4803 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
4805 if (kat2.le.1.0d-14) cycle
4806 kat=kat-dLOG(kat2/constr_homology)
4807 c write (iout,*) "kat",kat ! sum of -ln-s
4809 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
4810 ccc & dLOG(kat2), "-kat=", -kat
4813 c ----------------------------------------------------------------------
4815 c ----------------------------------------------------------------------
4819 do k=1,constr_homology
4821 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
4823 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
4825 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
4826 sum_sgdih=sum_sgdih+sgdih
4828 c grad_dih3=sum_sgdih/sum_gdih
4829 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
4831 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
4832 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
4833 ccc & gloc(nphi+i-3,icg)
4834 gloc(i,icg)=gloc(i,icg)+grad_dih3
4836 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
4838 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
4839 ccc & gloc(nphi+i-3,icg)
4841 enddo ! i-loop for dih
4843 write(iout,*) "------- dih restrs end -------"
4846 c Pseudo-energy and gradient for theta angle restraints from
4847 c homology templates
4848 c FP 01/15 - inserted from econstr_local_test.F, loop structure
4852 c For constr_homology reference structures (FP)
4854 c Uconst_back_tot=0.0d0
4857 c Econstr_back legacy
4860 c do i=ithet_start,ithet_end
4863 c do i=loc_start,loc_end
4866 duscdiffx(j,i)=0.0d0
4872 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
4873 c write (iout,*) "waga_theta",waga_theta
4874 if (waga_theta.gt.0.0d0) then
4876 write (iout,*) "usampl",usampl
4877 write(iout,*) "------- theta restrs start -------"
4878 c do i=ithet_start,ithet_end
4879 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
4882 c write (iout,*) "maxres",maxres,"nres",nres
4884 do i=ithet_start,ithet_end
4887 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
4889 c Deviation of theta angles wrt constr_homology ref structures
4891 utheta_i=0.0d0 ! argument of Gaussian for single k
4892 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4893 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
4894 c over residues in a fragment
4895 c write (iout,*) "theta(",i,")=",theta(i)
4896 do k=1,constr_homology
4898 c dtheta_i=theta(j)-thetaref(j,iref)
4899 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
4900 theta_diff(k)=thetatpl(k,i)-theta(i)
4902 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
4903 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
4904 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
4905 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
4906 c Gradient for single Gaussian restraint in subr Econstr_back
4907 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
4910 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
4911 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
4915 c Gradient for multiple Gaussian restraint
4916 sum_gtheta=gutheta_i
4918 do k=1,constr_homology
4919 c New generalized expr for multiple Gaussian from Econstr_back
4920 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
4922 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
4923 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
4926 c Final value of gradient using same var as in Econstr_back
4927 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
4928 & *waga_homology(iset)
4929 c dutheta(i)=sum_sgtheta/sum_gtheta
4931 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
4933 Eval=Eval-dLOG(gutheta_i/constr_homology)
4934 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
4935 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
4936 c Uconst_back=Uconst_back+utheta(i)
4937 enddo ! (i-loop for theta)
4939 write(iout,*) "------- theta restrs end -------"
4943 c Deviation of local SC geometry
4945 c Separation of two i-loops (instructed by AL - 11/3/2014)
4947 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
4948 c write (iout,*) "waga_d",waga_d
4951 write(iout,*) "------- SC restrs start -------"
4952 write (iout,*) "Initial duscdiff,duscdiffx"
4953 do i=loc_start,loc_end
4954 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
4955 & (duscdiffx(jik,i),jik=1,3)
4958 do i=loc_start,loc_end
4959 usc_diff_i=0.0d0 ! argument of Gaussian for single k
4960 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4961 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
4962 c write(iout,*) "xxtab, yytab, zztab"
4963 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
4964 do k=1,constr_homology
4966 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4967 c Original sign inverted for calc of gradients (s. Econstr_back)
4968 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4969 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4970 c write(iout,*) "dxx, dyy, dzz"
4971 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4973 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
4974 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
4975 c uscdiffk(k)=usc_diff(i)
4976 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
4977 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
4978 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
4979 c & xxref(j),yyref(j),zzref(j)
4984 c Generalized expression for multiple Gaussian acc to that for a single
4985 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
4987 c Original implementation
4988 c sum_guscdiff=guscdiff(i)
4990 c sum_sguscdiff=0.0d0
4991 c do k=1,constr_homology
4992 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
4993 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
4994 c sum_sguscdiff=sum_sguscdiff+sguscdiff
4997 c Implementation of new expressions for gradient (Jan. 2015)
4999 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
5001 do k=1,constr_homology
5003 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
5004 c before. Now the drivatives should be correct
5006 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
5007 c Original sign inverted for calc of gradients (s. Econstr_back)
5008 dyy=-yytpl(k,i)+yytab(i) ! ibid y
5009 dzz=-zztpl(k,i)+zztab(i) ! ibid z
5011 c New implementation
5013 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
5014 & sigma_d(k,i) ! for the grad wrt r'
5015 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
5018 c New implementation
5019 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
5021 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
5022 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
5023 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
5024 duscdiff(jik,i)=duscdiff(jik,i)+
5025 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
5026 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
5027 duscdiffx(jik,i)=duscdiffx(jik,i)+
5028 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
5029 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
5032 write(iout,*) "jik",jik,"i",i
5033 write(iout,*) "dxx, dyy, dzz"
5034 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
5035 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
5036 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
5037 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
5038 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
5039 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
5040 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
5041 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
5042 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
5043 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
5044 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
5045 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
5046 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
5047 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
5048 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
5055 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
5056 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
5058 c write (iout,*) i," uscdiff",uscdiff(i)
5060 c Put together deviations from local geometry
5062 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
5063 c & wfrag_back(3,i,iset)*uscdiff(i)
5064 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
5065 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
5066 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
5067 c Uconst_back=Uconst_back+usc_diff(i)
5069 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
5071 c New implment: multiplied by sum_sguscdiff
5074 enddo ! (i-loop for dscdiff)
5079 write(iout,*) "------- SC restrs end -------"
5080 write (iout,*) "------ After SC loop in e_modeller ------"
5081 do i=loc_start,loc_end
5082 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
5083 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
5085 if (waga_theta.eq.1.0d0) then
5086 write (iout,*) "in e_modeller after SC restr end: dutheta"
5087 do i=ithet_start,ithet_end
5088 write (iout,*) i,dutheta(i)
5091 if (waga_d.eq.1.0d0) then
5092 write (iout,*) "e_modeller after SC loop: duscdiff/x"
5094 write (iout,*) i,(duscdiff(j,i),j=1,3)
5095 write (iout,*) i,(duscdiffx(j,i),j=1,3)
5100 c Total energy from homology restraints
5102 write (iout,*) "odleg",odleg," kat",kat
5103 write (iout,*) "odleg",odleg," kat",kat
5104 write (iout,*) "Eval",Eval," Erot",Erot
5105 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
5106 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
5107 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
5110 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
5112 c ehomology_constr=odleg+kat
5114 c For Lorentzian-type Urestr
5117 if (waga_dist.ge.0.0d0) then
5119 c For Gaussian-type Urestr
5121 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
5122 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
5123 ehomology_constr=waga_dist*odleg+waga_angle*kat+
5124 & waga_theta*Eval+waga_d*Erot
5125 c write (iout,*) "ehomology_constr=",ehomology_constr
5128 c For Lorentzian-type Urestr
5130 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
5131 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
5132 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
5133 & waga_theta*Eval+waga_d*Erot
5134 c write (iout,*) "ehomology_constr=",ehomology_constr
5137 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
5138 & "Eval",waga_theta,eval,
5139 & "Erot",waga_d,Erot
5140 write (iout,*) "ehomology_constr",ehomology_constr
5144 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
5145 747 format(a12,i4,i4,i4,f8.3,f8.3)
5146 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
5147 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
5148 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
5149 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
5151 c-----------------------------------------------------------------------
5152 subroutine ebond(estr)
5154 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5156 implicit real*8 (a-h,o-z)
5157 include 'DIMENSIONS'
5158 include 'DIMENSIONS.ZSCOPT'
5159 include 'COMMON.LOCAL'
5160 include 'COMMON.GEO'
5161 include 'COMMON.INTERACT'
5162 include 'COMMON.DERIV'
5163 include 'COMMON.VAR'
5164 include 'COMMON.CHAIN'
5165 include 'COMMON.IOUNITS'
5166 include 'COMMON.NAMES'
5167 include 'COMMON.FFIELD'
5168 include 'COMMON.CONTROL'
5169 double precision u(3),ud(3)
5172 c write (iout,*) "distchainmax",distchainmax
5175 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
5176 diff = vbld(i)-vbldp0
5178 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5179 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5181 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5182 C & *dc(j,i-1)/vbld(i)
5184 C if (energy_dec) write(iout,*)
5185 C & "estr1",i,vbld(i),distchainmax,
5186 C & gnmr1(vbld(i),-1.0d0,distchainmax)
5188 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5189 diff = vbld(i)-vbldpDUM
5190 C write(iout,*) i,diff
5192 diff = vbld(i)-vbldp0
5193 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
5198 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5201 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5202 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5204 estr=0.5d0*AKP*estr+estr1
5206 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5210 if (iti.ne.10 .and. iti.ne.ntyp1) then
5213 diff=vbld(i+nres)-vbldsc0(1,iti)
5214 if (energy_dec) write (iout,*) "estr sc",iti,vbld(i+nres),
5215 & vbldsc0(1,iti),diff,
5216 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5217 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5219 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5223 diff=vbld(i+nres)-vbldsc0(j,iti)
5224 ud(j)=aksc(j,iti)*diff
5225 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5239 uprod2=uprod2*u(k)*u(k)
5243 usumsqder=usumsqder+ud(j)*uprod2
5245 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
5246 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
5247 estr=estr+uprod/usum
5249 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5257 C--------------------------------------------------------------------------
5258 subroutine ebend(etheta,ethetacnstr)
5260 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5261 C angles gamma and its derivatives in consecutive thetas and gammas.
5263 implicit real*8 (a-h,o-z)
5264 include 'DIMENSIONS'
5265 include 'DIMENSIONS.ZSCOPT'
5266 include 'COMMON.LOCAL'
5267 include 'COMMON.GEO'
5268 include 'COMMON.INTERACT'
5269 include 'COMMON.DERIV'
5270 include 'COMMON.VAR'
5271 include 'COMMON.CHAIN'
5272 include 'COMMON.IOUNITS'
5273 include 'COMMON.NAMES'
5274 include 'COMMON.FFIELD'
5275 include 'COMMON.TORCNSTR'
5276 common /calcthet/ term1,term2,termm,diffak,ratak,
5277 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5278 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5279 double precision y(2),z(2)
5281 c time11=dexp(-2*time)
5284 c write (iout,*) "nres",nres
5285 c write (*,'(a,i2)') 'EBEND ICG=',icg
5286 c write (iout,*) ithet_start,ithet_end
5287 do i=ithet_start,ithet_end
5288 C if (itype(i-1).eq.ntyp1) cycle
5290 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5291 & .or.itype(i).eq.ntyp1) cycle
5292 C Zero the energy function and its derivative at 0 or pi.
5293 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5295 ichir1=isign(1,itype(i-2))
5296 ichir2=isign(1,itype(i))
5297 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5298 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5299 if (itype(i-1).eq.10) then
5300 itype1=isign(10,itype(i-2))
5301 ichir11=isign(1,itype(i-2))
5302 ichir12=isign(1,itype(i-2))
5303 itype2=isign(10,itype(i))
5304 ichir21=isign(1,itype(i))
5305 ichir22=isign(1,itype(i))
5312 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5316 c call proc_proc(phii,icrc)
5317 if (icrc.eq.1) phii=150.0
5328 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5332 c call proc_proc(phii1,icrc)
5333 if (icrc.eq.1) phii1=150.0
5345 C Calculate the "mean" value of theta from the part of the distribution
5346 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5347 C In following comments this theta will be referred to as t_c.
5348 thet_pred_mean=0.0d0
5350 athetk=athet(k,it,ichir1,ichir2)
5351 bthetk=bthet(k,it,ichir1,ichir2)
5353 athetk=athet(k,itype1,ichir11,ichir12)
5354 bthetk=bthet(k,itype2,ichir21,ichir22)
5356 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5358 c write (iout,*) "thet_pred_mean",thet_pred_mean
5359 dthett=thet_pred_mean*ssd
5360 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5361 c write (iout,*) "thet_pred_mean",thet_pred_mean
5362 C Derivatives of the "mean" values in gamma1 and gamma2.
5363 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5364 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5365 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5366 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5368 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5369 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5370 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5371 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5373 if (theta(i).gt.pi-delta) then
5374 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5376 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5377 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5378 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5380 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5382 else if (theta(i).lt.delta) then
5383 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5384 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5385 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5387 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5388 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5391 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5394 etheta=etheta+ethetai
5395 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5396 c & 'ebend',i,ethetai,theta(i),itype(i)
5397 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5398 c & rad2deg*phii,rad2deg*phii1,ethetai
5399 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5400 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5401 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5405 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5406 do i=1,ntheta_constr
5407 itheta=itheta_constr(i)
5408 thetiii=theta(itheta)
5409 difi=pinorm(thetiii-theta_constr0(i))
5410 if (difi.gt.theta_drange(i)) then
5411 difi=difi-theta_drange(i)
5412 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5413 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5414 & +for_thet_constr(i)*difi**3
5415 else if (difi.lt.-drange(i)) then
5417 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5418 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5419 & +for_thet_constr(i)*difi**3
5423 C if (energy_dec) then
5424 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5425 C & i,itheta,rad2deg*thetiii,
5426 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5427 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5428 C & gloc(itheta+nphi-2,icg)
5431 C Ufff.... We've done all this!!!
5434 C---------------------------------------------------------------------------
5435 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5437 implicit real*8 (a-h,o-z)
5438 include 'DIMENSIONS'
5439 include 'COMMON.LOCAL'
5440 include 'COMMON.IOUNITS'
5441 common /calcthet/ term1,term2,termm,diffak,ratak,
5442 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5443 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5444 C Calculate the contributions to both Gaussian lobes.
5445 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5446 C The "polynomial part" of the "standard deviation" of this part of
5450 sig=sig*thet_pred_mean+polthet(j,it)
5452 C Derivative of the "interior part" of the "standard deviation of the"
5453 C gamma-dependent Gaussian lobe in t_c.
5454 sigtc=3*polthet(3,it)
5456 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5459 C Set the parameters of both Gaussian lobes of the distribution.
5460 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5461 fac=sig*sig+sigc0(it)
5464 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5465 sigsqtc=-4.0D0*sigcsq*sigtc
5466 c print *,i,sig,sigtc,sigsqtc
5467 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5468 sigtc=-sigtc/(fac*fac)
5469 C Following variable is sigma(t_c)**(-2)
5470 sigcsq=sigcsq*sigcsq
5472 sig0inv=1.0D0/sig0i**2
5473 delthec=thetai-thet_pred_mean
5474 delthe0=thetai-theta0i
5475 term1=-0.5D0*sigcsq*delthec*delthec
5476 term2=-0.5D0*sig0inv*delthe0*delthe0
5477 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5478 C NaNs in taking the logarithm. We extract the largest exponent which is added
5479 C to the energy (this being the log of the distribution) at the end of energy
5480 C term evaluation for this virtual-bond angle.
5481 if (term1.gt.term2) then
5483 term2=dexp(term2-termm)
5487 term1=dexp(term1-termm)
5490 C The ratio between the gamma-independent and gamma-dependent lobes of
5491 C the distribution is a Gaussian function of thet_pred_mean too.
5492 diffak=gthet(2,it)-thet_pred_mean
5493 ratak=diffak/gthet(3,it)**2
5494 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5495 C Let's differentiate it in thet_pred_mean NOW.
5497 C Now put together the distribution terms to make complete distribution.
5498 termexp=term1+ak*term2
5499 termpre=sigc+ak*sig0i
5500 C Contribution of the bending energy from this theta is just the -log of
5501 C the sum of the contributions from the two lobes and the pre-exponential
5502 C factor. Simple enough, isn't it?
5503 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5504 C NOW the derivatives!!!
5505 C 6/6/97 Take into account the deformation.
5506 E_theta=(delthec*sigcsq*term1
5507 & +ak*delthe0*sig0inv*term2)/termexp
5508 E_tc=((sigtc+aktc*sig0i)/termpre
5509 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5510 & aktc*term2)/termexp)
5513 c-----------------------------------------------------------------------------
5514 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5515 implicit real*8 (a-h,o-z)
5516 include 'DIMENSIONS'
5517 include 'COMMON.LOCAL'
5518 include 'COMMON.IOUNITS'
5519 common /calcthet/ term1,term2,termm,diffak,ratak,
5520 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5521 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5522 delthec=thetai-thet_pred_mean
5523 delthe0=thetai-theta0i
5524 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5525 t3 = thetai-thet_pred_mean
5529 t14 = t12+t6*sigsqtc
5531 t21 = thetai-theta0i
5537 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5538 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5539 & *(-t12*t9-ak*sig0inv*t27)
5543 C--------------------------------------------------------------------------
5544 subroutine ebend(etheta)
5546 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5547 C angles gamma and its derivatives in consecutive thetas and gammas.
5548 C ab initio-derived potentials from
5549 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5551 implicit real*8 (a-h,o-z)
5552 include 'DIMENSIONS'
5553 include 'DIMENSIONS.ZSCOPT'
5554 include 'COMMON.LOCAL'
5555 include 'COMMON.GEO'
5556 include 'COMMON.INTERACT'
5557 include 'COMMON.DERIV'
5558 include 'COMMON.VAR'
5559 include 'COMMON.CHAIN'
5560 include 'COMMON.IOUNITS'
5561 include 'COMMON.NAMES'
5562 include 'COMMON.FFIELD'
5563 include 'COMMON.CONTROL'
5564 include 'COMMON.TORCNSTR'
5565 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5566 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5567 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5568 & sinph1ph2(maxdouble,maxdouble)
5569 logical lprn /.false./, lprn1 /.false./
5571 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5572 do i=ithet_start,ithet_end
5574 C if (itype(i-1).eq.ntyp1) cycle
5576 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5577 & .or.itype(i).eq.ntyp1) cycle
5578 if (iabs(itype(i+1)).eq.20) iblock=2
5579 if (iabs(itype(i+1)).ne.20) iblock=1
5583 theti2=0.5d0*theta(i)
5584 ityp2=ithetyp((itype(i-1)))
5586 coskt(k)=dcos(k*theti2)
5587 sinkt(k)=dsin(k*theti2)
5597 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5600 if (phii.ne.phii) phii=150.0
5604 ityp1=ithetyp((itype(i-2)))
5606 cosph1(k)=dcos(k*phii)
5607 sinph1(k)=dsin(k*phii)
5613 ityp1=ithetyp((itype(i-2)))
5618 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5621 if (phii1.ne.phii1) phii1=150.0
5626 ityp3=ithetyp((itype(i)))
5628 cosph2(k)=dcos(k*phii1)
5629 sinph2(k)=dsin(k*phii1)
5634 ityp3=ithetyp((itype(i)))
5640 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5641 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5643 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5646 ccl=cosph1(l)*cosph2(k-l)
5647 ssl=sinph1(l)*sinph2(k-l)
5648 scl=sinph1(l)*cosph2(k-l)
5649 csl=cosph1(l)*sinph2(k-l)
5650 cosph1ph2(l,k)=ccl-ssl
5651 cosph1ph2(k,l)=ccl+ssl
5652 sinph1ph2(l,k)=scl+csl
5653 sinph1ph2(k,l)=scl-csl
5657 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5658 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5659 write (iout,*) "coskt and sinkt"
5661 write (iout,*) k,coskt(k),sinkt(k)
5665 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5666 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5669 & write (iout,*) "k",k,"
5670 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5671 & " ethetai",ethetai
5674 write (iout,*) "cosph and sinph"
5676 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5678 write (iout,*) "cosph1ph2 and sinph2ph2"
5681 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5682 & sinph1ph2(l,k),sinph1ph2(k,l)
5685 write(iout,*) "ethetai",ethetai
5689 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5690 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5691 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5692 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5693 ethetai=ethetai+sinkt(m)*aux
5694 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5695 dephii=dephii+k*sinkt(m)*(
5696 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5697 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5698 dephii1=dephii1+k*sinkt(m)*(
5699 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5700 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5702 & write (iout,*) "m",m," k",k," bbthet",
5703 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5704 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5705 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5706 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5710 & write(iout,*) "ethetai",ethetai
5714 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5715 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5716 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5717 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5718 ethetai=ethetai+sinkt(m)*aux
5719 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5720 dephii=dephii+l*sinkt(m)*(
5721 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5722 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5723 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5724 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5725 dephii1=dephii1+(k-l)*sinkt(m)*(
5726 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5727 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5728 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5729 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5731 write (iout,*) "m",m," k",k," l",l," ffthet",
5732 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5733 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5734 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5735 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5736 & " ethetai",ethetai
5737 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5738 & cosph1ph2(k,l)*sinkt(m),
5739 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5745 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5746 & i,theta(i)*rad2deg,phii*rad2deg,
5747 & phii1*rad2deg,ethetai
5748 etheta=etheta+ethetai
5749 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5750 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5751 c gloc(nphi+i-2,icg)=wang*dethetai
5752 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5758 c-----------------------------------------------------------------------------
5759 subroutine esc(escloc)
5760 C Calculate the local energy of a side chain and its derivatives in the
5761 C corresponding virtual-bond valence angles THETA and the spherical angles
5763 implicit real*8 (a-h,o-z)
5764 include 'DIMENSIONS'
5765 include 'DIMENSIONS.ZSCOPT'
5766 include 'COMMON.GEO'
5767 include 'COMMON.LOCAL'
5768 include 'COMMON.VAR'
5769 include 'COMMON.INTERACT'
5770 include 'COMMON.DERIV'
5771 include 'COMMON.CHAIN'
5772 include 'COMMON.IOUNITS'
5773 include 'COMMON.NAMES'
5774 include 'COMMON.FFIELD'
5775 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5776 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5777 common /sccalc/ time11,time12,time112,theti,it,nlobit
5780 C write (iout,*) 'ESC'
5781 do i=loc_start,loc_end
5783 if (it.eq.ntyp1) cycle
5784 if (it.eq.10) goto 1
5785 nlobit=nlob(iabs(it))
5786 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5787 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5788 theti=theta(i+1)-pipol
5792 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5794 if (x(2).gt.pi-delta) then
5798 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5800 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5801 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5803 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5804 & ddersc0(1),dersc(1))
5805 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5806 & ddersc0(3),dersc(3))
5808 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5810 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5811 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5812 & dersc0(2),esclocbi,dersc02)
5813 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5815 call splinthet(x(2),0.5d0*delta,ss,ssd)
5820 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5822 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5823 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5825 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5827 c write (iout,*) escloci
5828 else if (x(2).lt.delta) then
5832 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5834 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5835 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5837 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5838 & ddersc0(1),dersc(1))
5839 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5840 & ddersc0(3),dersc(3))
5842 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5844 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5845 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5846 & dersc0(2),esclocbi,dersc02)
5847 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5852 call splinthet(x(2),0.5d0*delta,ss,ssd)
5854 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5856 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5857 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5859 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5860 C write (iout,*) 'i=',i, escloci
5862 call enesc(x,escloci,dersc,ddummy,.false.)
5865 escloc=escloc+escloci
5866 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5867 write (iout,'(a6,i5,0pf7.3)')
5868 & 'escloc',i,escloci
5870 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5872 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5873 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5878 C---------------------------------------------------------------------------
5879 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5880 implicit real*8 (a-h,o-z)
5881 include 'DIMENSIONS'
5882 include 'COMMON.GEO'
5883 include 'COMMON.LOCAL'
5884 include 'COMMON.IOUNITS'
5885 common /sccalc/ time11,time12,time112,theti,it,nlobit
5886 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5887 double precision contr(maxlob,-1:1)
5889 c write (iout,*) 'it=',it,' nlobit=',nlobit
5893 if (mixed) ddersc(j)=0.0d0
5897 C Because of periodicity of the dependence of the SC energy in omega we have
5898 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5899 C To avoid underflows, first compute & store the exponents.
5907 z(k)=x(k)-censc(k,j,it)
5912 Axk=Axk+gaussc(l,k,j,it)*z(l)
5918 expfac=expfac+Ax(k,j,iii)*z(k)
5926 C As in the case of ebend, we want to avoid underflows in exponentiation and
5927 C subsequent NaNs and INFs in energy calculation.
5928 C Find the largest exponent
5932 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5936 cd print *,'it=',it,' emin=',emin
5938 C Compute the contribution to SC energy and derivatives
5942 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5943 cd print *,'j=',j,' expfac=',expfac
5944 escloc_i=escloc_i+expfac
5946 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5950 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5951 & +gaussc(k,2,j,it))*expfac
5958 dersc(1)=dersc(1)/cos(theti)**2
5959 ddersc(1)=ddersc(1)/cos(theti)**2
5962 escloci=-(dlog(escloc_i)-emin)
5964 dersc(j)=dersc(j)/escloc_i
5968 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5973 C------------------------------------------------------------------------------
5974 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5975 implicit real*8 (a-h,o-z)
5976 include 'DIMENSIONS'
5977 include 'COMMON.GEO'
5978 include 'COMMON.LOCAL'
5979 include 'COMMON.IOUNITS'
5980 common /sccalc/ time11,time12,time112,theti,it,nlobit
5981 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5982 double precision contr(maxlob)
5993 z(k)=x(k)-censc(k,j,it)
5999 Axk=Axk+gaussc(l,k,j,it)*z(l)
6005 expfac=expfac+Ax(k,j)*z(k)
6010 C As in the case of ebend, we want to avoid underflows in exponentiation and
6011 C subsequent NaNs and INFs in energy calculation.
6012 C Find the largest exponent
6015 if (emin.gt.contr(j)) emin=contr(j)
6019 C Compute the contribution to SC energy and derivatives
6023 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6024 escloc_i=escloc_i+expfac
6026 dersc(k)=dersc(k)+Ax(k,j)*expfac
6028 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6029 & +gaussc(1,2,j,it))*expfac
6033 dersc(1)=dersc(1)/cos(theti)**2
6034 dersc12=dersc12/cos(theti)**2
6035 escloci=-(dlog(escloc_i)-emin)
6037 dersc(j)=dersc(j)/escloc_i
6039 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6043 c----------------------------------------------------------------------------------
6044 subroutine esc(escloc)
6045 C Calculate the local energy of a side chain and its derivatives in the
6046 C corresponding virtual-bond valence angles THETA and the spherical angles
6047 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6048 C added by Urszula Kozlowska. 07/11/2007
6050 implicit real*8 (a-h,o-z)
6051 include 'DIMENSIONS'
6052 include 'DIMENSIONS.ZSCOPT'
6053 include 'COMMON.GEO'
6054 include 'COMMON.LOCAL'
6055 include 'COMMON.VAR'
6056 include 'COMMON.SCROT'
6057 include 'COMMON.INTERACT'
6058 include 'COMMON.DERIV'
6059 include 'COMMON.CHAIN'
6060 include 'COMMON.IOUNITS'
6061 include 'COMMON.NAMES'
6062 include 'COMMON.FFIELD'
6063 include 'COMMON.CONTROL'
6064 include 'COMMON.VECTORS'
6065 double precision x_prime(3),y_prime(3),z_prime(3)
6066 & , sumene,dsc_i,dp2_i,x(65),
6067 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6068 & de_dxx,de_dyy,de_dzz,de_dt
6069 double precision s1_t,s1_6_t,s2_t,s2_6_t
6071 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6072 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6073 & dt_dCi(3),dt_dCi1(3)
6074 common /sccalc/ time11,time12,time112,theti,it,nlobit
6077 do i=loc_start,loc_end
6078 if (itype(i).eq.ntyp1) cycle
6079 costtab(i+1) =dcos(theta(i+1))
6080 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6081 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6082 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6083 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6084 cosfac=dsqrt(cosfac2)
6085 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6086 sinfac=dsqrt(sinfac2)
6088 if (it.eq.10) goto 1
6090 C Compute the axes of tghe local cartesian coordinates system; store in
6091 c x_prime, y_prime and z_prime
6098 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6099 C & dc_norm(3,i+nres)
6101 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6102 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6105 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6108 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6109 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6110 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6111 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6112 c & " xy",scalar(x_prime(1),y_prime(1)),
6113 c & " xz",scalar(x_prime(1),z_prime(1)),
6114 c & " yy",scalar(y_prime(1),y_prime(1)),
6115 c & " yz",scalar(y_prime(1),z_prime(1)),
6116 c & " zz",scalar(z_prime(1),z_prime(1))
6118 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6119 C to local coordinate system. Store in xx, yy, zz.
6125 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6126 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6127 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6134 C Compute the energy of the ith side cbain
6136 c write (2,*) "xx",xx," yy",yy," zz",zz
6139 x(j) = sc_parmin(j,it)
6142 Cc diagnostics - remove later
6144 yy1 = dsin(alph(2))*dcos(omeg(2))
6145 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
6146 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6147 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6149 C," --- ", xx_w,yy_w,zz_w
6152 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6153 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6155 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6156 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6158 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6159 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6160 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6161 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6162 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6164 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6165 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6166 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6167 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6168 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6170 dsc_i = 0.743d0+x(61)
6172 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6173 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6174 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6175 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6176 s1=(1+x(63))/(0.1d0 + dscp1)
6177 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6178 s2=(1+x(65))/(0.1d0 + dscp2)
6179 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6180 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6181 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6182 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6184 c & dscp1,dscp2,sumene
6185 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6186 escloc = escloc + sumene
6187 c write (2,*) "escloc",escloc
6188 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
6190 if (.not. calc_grad) goto 1
6193 C This section to check the numerical derivatives of the energy of ith side
6194 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6195 C #define DEBUG in the code to turn it on.
6197 write (2,*) "sumene =",sumene
6201 write (2,*) xx,yy,zz
6202 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6203 de_dxx_num=(sumenep-sumene)/aincr
6205 write (2,*) "xx+ sumene from enesc=",sumenep
6208 write (2,*) xx,yy,zz
6209 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6210 de_dyy_num=(sumenep-sumene)/aincr
6212 write (2,*) "yy+ sumene from enesc=",sumenep
6215 write (2,*) xx,yy,zz
6216 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6217 de_dzz_num=(sumenep-sumene)/aincr
6219 write (2,*) "zz+ sumene from enesc=",sumenep
6220 costsave=cost2tab(i+1)
6221 sintsave=sint2tab(i+1)
6222 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6223 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6224 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6225 de_dt_num=(sumenep-sumene)/aincr
6226 write (2,*) " t+ sumene from enesc=",sumenep
6227 cost2tab(i+1)=costsave
6228 sint2tab(i+1)=sintsave
6229 C End of diagnostics section.
6232 C Compute the gradient of esc
6234 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6235 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6236 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6237 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6238 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6239 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6240 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6241 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6242 pom1=(sumene3*sint2tab(i+1)+sumene1)
6243 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6244 pom2=(sumene4*cost2tab(i+1)+sumene2)
6245 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6246 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6247 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6248 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6250 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6251 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6252 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6254 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6255 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6256 & +(pom1+pom2)*pom_dx
6258 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
6261 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6262 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6263 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6265 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6266 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6267 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6268 & +x(59)*zz**2 +x(60)*xx*zz
6269 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6270 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6271 & +(pom1-pom2)*pom_dy
6273 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
6276 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6277 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6278 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6279 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6280 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6281 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6282 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6283 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6285 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
6288 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6289 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6290 & +pom1*pom_dt1+pom2*pom_dt2
6292 write(2,*), "de_dt = ", de_dt,de_dt_num
6296 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6297 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6298 cosfac2xx=cosfac2*xx
6299 sinfac2yy=sinfac2*yy
6301 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6303 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6305 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6306 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6307 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6308 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6309 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6310 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6311 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6312 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6313 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6314 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6318 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6319 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6320 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6321 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6324 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6325 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6326 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
6328 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6329 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6333 dXX_Ctab(k,i)=dXX_Ci(k)
6334 dXX_C1tab(k,i)=dXX_Ci1(k)
6335 dYY_Ctab(k,i)=dYY_Ci(k)
6336 dYY_C1tab(k,i)=dYY_Ci1(k)
6337 dZZ_Ctab(k,i)=dZZ_Ci(k)
6338 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6339 dXX_XYZtab(k,i)=dXX_XYZ(k)
6340 dYY_XYZtab(k,i)=dYY_XYZ(k)
6341 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6345 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6346 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6347 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6348 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6349 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6351 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6352 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6353 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6354 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6355 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6356 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6357 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6358 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6360 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6361 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6363 C to check gradient call subroutine check_grad
6370 c------------------------------------------------------------------------------
6371 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6373 C This procedure calculates two-body contact function g(rij) and its derivative:
6376 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6379 C where x=(rij-r0ij)/delta
6381 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6384 double precision rij,r0ij,eps0ij,fcont,fprimcont
6385 double precision x,x2,x4,delta
6389 if (x.lt.-1.0D0) then
6392 else if (x.le.1.0D0) then
6395 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6396 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6403 c------------------------------------------------------------------------------
6404 subroutine splinthet(theti,delta,ss,ssder)
6405 implicit real*8 (a-h,o-z)
6406 include 'DIMENSIONS'
6407 include 'DIMENSIONS.ZSCOPT'
6408 include 'COMMON.VAR'
6409 include 'COMMON.GEO'
6412 if (theti.gt.pipol) then
6413 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6415 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6420 c------------------------------------------------------------------------------
6421 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6423 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6424 double precision ksi,ksi2,ksi3,a1,a2,a3
6425 a1=fprim0*delta/(f1-f0)
6431 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6432 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6435 c------------------------------------------------------------------------------
6436 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6438 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6439 double precision ksi,ksi2,ksi3,a1,a2,a3
6444 a2=3*(f1x-f0x)-2*fprim0x*delta
6445 a3=fprim0x*delta-2*(f1x-f0x)
6446 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6449 C-----------------------------------------------------------------------------
6451 C-----------------------------------------------------------------------------
6452 subroutine etor(etors,fact)
6453 implicit real*8 (a-h,o-z)
6454 include 'DIMENSIONS'
6455 include 'DIMENSIONS.ZSCOPT'
6456 include 'COMMON.VAR'
6457 include 'COMMON.GEO'
6458 include 'COMMON.LOCAL'
6459 include 'COMMON.TORSION'
6460 include 'COMMON.INTERACT'
6461 include 'COMMON.DERIV'
6462 include 'COMMON.CHAIN'
6463 include 'COMMON.NAMES'
6464 include 'COMMON.IOUNITS'
6465 include 'COMMON.FFIELD'
6466 include 'COMMON.TORCNSTR'
6468 C Set lprn=.true. for debugging
6472 do i=iphi_start,iphi_end
6473 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6474 & .or. itype(i).eq.ntyp1) cycle
6475 itori=itortyp(itype(i-2))
6476 itori1=itortyp(itype(i-1))
6479 C Proline-Proline pair is a special case...
6480 if (itori.eq.3 .and. itori1.eq.3) then
6481 if (phii.gt.-dwapi3) then
6483 fac=1.0D0/(1.0D0-cosphi)
6484 etorsi=v1(1,3,3)*fac
6485 etorsi=etorsi+etorsi
6486 etors=etors+etorsi-v1(1,3,3)
6487 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6490 v1ij=v1(j+1,itori,itori1)
6491 v2ij=v2(j+1,itori,itori1)
6494 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6495 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6499 v1ij=v1(j,itori,itori1)
6500 v2ij=v2(j,itori,itori1)
6503 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6504 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6508 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6509 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6510 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6511 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6512 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6516 c------------------------------------------------------------------------------
6518 subroutine etor(etors,fact)
6519 implicit real*8 (a-h,o-z)
6520 include 'DIMENSIONS'
6521 include 'DIMENSIONS.ZSCOPT'
6522 include 'COMMON.VAR'
6523 include 'COMMON.GEO'
6524 include 'COMMON.LOCAL'
6525 include 'COMMON.TORSION'
6526 include 'COMMON.INTERACT'
6527 include 'COMMON.DERIV'
6528 include 'COMMON.CHAIN'
6529 include 'COMMON.NAMES'
6530 include 'COMMON.IOUNITS'
6531 include 'COMMON.FFIELD'
6532 include 'COMMON.TORCNSTR'
6534 C Set lprn=.true. for debugging
6538 do i=iphi_start,iphi_end
6540 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6541 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6542 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6543 C & .or. itype(i).eq.ntyp1) cycle
6544 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6545 if (iabs(itype(i)).eq.20) then
6550 itori=itortyp(itype(i-2))
6551 itori1=itortyp(itype(i-1))
6554 C Regular cosine and sine terms
6555 do j=1,nterm(itori,itori1,iblock)
6556 v1ij=v1(j,itori,itori1,iblock)
6557 v2ij=v2(j,itori,itori1,iblock)
6560 etors=etors+v1ij*cosphi+v2ij*sinphi
6561 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6565 C E = SUM ----------------------------------- - v1
6566 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6568 cosphi=dcos(0.5d0*phii)
6569 sinphi=dsin(0.5d0*phii)
6570 do j=1,nlor(itori,itori1,iblock)
6571 vl1ij=vlor1(j,itori,itori1)
6572 vl2ij=vlor2(j,itori,itori1)
6573 vl3ij=vlor3(j,itori,itori1)
6574 pom=vl2ij*cosphi+vl3ij*sinphi
6575 pom1=1.0d0/(pom*pom+1.0d0)
6576 etors=etors+vl1ij*pom1
6577 c if (energy_dec) etors_ii=etors_ii+
6580 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6582 C Subtract the constant term
6583 etors=etors-v0(itori,itori1,iblock)
6585 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6586 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6587 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
6588 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6589 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6594 c----------------------------------------------------------------------------
6595 subroutine etor_d(etors_d,fact2)
6596 C 6/23/01 Compute double torsional energy
6597 implicit real*8 (a-h,o-z)
6598 include 'DIMENSIONS'
6599 include 'DIMENSIONS.ZSCOPT'
6600 include 'COMMON.VAR'
6601 include 'COMMON.GEO'
6602 include 'COMMON.LOCAL'
6603 include 'COMMON.TORSION'
6604 include 'COMMON.INTERACT'
6605 include 'COMMON.DERIV'
6606 include 'COMMON.CHAIN'
6607 include 'COMMON.NAMES'
6608 include 'COMMON.IOUNITS'
6609 include 'COMMON.FFIELD'
6610 include 'COMMON.TORCNSTR'
6612 C Set lprn=.true. for debugging
6616 do i=iphi_start,iphi_end-1
6618 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6619 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
6620 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6621 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6622 & (itype(i+1).eq.ntyp1)) cycle
6623 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6625 itori=itortyp(itype(i-2))
6626 itori1=itortyp(itype(i-1))
6627 itori2=itortyp(itype(i))
6633 if (iabs(itype(i+1)).eq.20) iblock=2
6634 C Regular cosine and sine terms
6635 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6636 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6637 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6638 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6639 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6640 cosphi1=dcos(j*phii)
6641 sinphi1=dsin(j*phii)
6642 cosphi2=dcos(j*phii1)
6643 sinphi2=dsin(j*phii1)
6644 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6645 & v2cij*cosphi2+v2sij*sinphi2
6646 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6647 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6649 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6651 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6652 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6653 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6654 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6655 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6656 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6657 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6658 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6659 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6660 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6661 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6662 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6663 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6664 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6667 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6668 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6674 c---------------------------------------------------------------------------
6675 C The rigorous attempt to derive energy function
6676 subroutine etor_kcc(etors,fact)
6677 implicit real*8 (a-h,o-z)
6678 include 'DIMENSIONS'
6679 include 'DIMENSIONS.ZSCOPT'
6680 include 'COMMON.VAR'
6681 include 'COMMON.GEO'
6682 include 'COMMON.LOCAL'
6683 include 'COMMON.TORSION'
6684 include 'COMMON.INTERACT'
6685 include 'COMMON.DERIV'
6686 include 'COMMON.CHAIN'
6687 include 'COMMON.NAMES'
6688 include 'COMMON.IOUNITS'
6689 include 'COMMON.FFIELD'
6690 include 'COMMON.TORCNSTR'
6691 include 'COMMON.CONTROL'
6692 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
6694 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
6695 C Set lprn=.true. for debugging
6698 C print *,"wchodze kcc"
6699 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
6701 do i=iphi_start,iphi_end
6702 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6703 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6704 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6705 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6706 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6707 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6708 itori=itortyp(itype(i-2))
6709 itori1=itortyp(itype(i-1))
6714 C to avoid multiple devision by 2
6715 c theti22=0.5d0*theta(i)
6716 C theta 12 is the theta_1 /2
6717 C theta 22 is theta_2 /2
6718 c theti12=0.5d0*theta(i-1)
6719 C and appropriate sinus function
6720 sinthet1=dsin(theta(i-1))
6721 sinthet2=dsin(theta(i))
6722 costhet1=dcos(theta(i-1))
6723 costhet2=dcos(theta(i))
6724 C to speed up lets store its mutliplication
6725 sint1t2=sinthet2*sinthet1
6727 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
6728 C +d_n*sin(n*gamma)) *
6729 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
6730 C we have two sum 1) Non-Chebyshev which is with n and gamma
6731 nval=nterm_kcc_Tb(itori,itori1)
6737 c1(j)=c1(j-1)*costhet1
6738 c2(j)=c2(j-1)*costhet2
6741 do j=1,nterm_kcc(itori,itori1)
6745 sint1t2n=sint1t2n*sint1t2
6751 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6752 gradvalct1=gradvalct1+
6753 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6754 gradvalct2=gradvalct2+
6755 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6758 gradvalct1=-gradvalct1*sinthet1
6759 gradvalct2=-gradvalct2*sinthet2
6765 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6766 gradvalst1=gradvalst1+
6767 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6768 gradvalst2=gradvalst2+
6769 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6772 gradvalst1=-gradvalst1*sinthet1
6773 gradvalst2=-gradvalst2*sinthet2
6774 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6775 C glocig is the gradient local i site in gamma
6776 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6777 C now gradient over theta_1
6778 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6779 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6780 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6781 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6784 C derivative over gamma
6785 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6786 C derivative over theta1
6787 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6788 C now derivative over theta2
6789 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6791 write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6792 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6793 write (iout,*) "c1",(c1(k),k=0,nval),
6794 & " c2",(c2(k),k=0,nval)
6795 write (iout,*) "sumvalc",sumvalc," sumvals",sumvals
6800 c---------------------------------------------------------------------------------------------
6801 subroutine etor_constr(edihcnstr)
6802 implicit real*8 (a-h,o-z)
6803 include 'DIMENSIONS'
6804 include 'DIMENSIONS.ZSCOPT'
6805 include 'COMMON.VAR'
6806 include 'COMMON.GEO'
6807 include 'COMMON.LOCAL'
6808 include 'COMMON.TORSION'
6809 include 'COMMON.INTERACT'
6810 include 'COMMON.DERIV'
6811 include 'COMMON.CHAIN'
6812 include 'COMMON.NAMES'
6813 include 'COMMON.IOUNITS'
6814 include 'COMMON.FFIELD'
6815 include 'COMMON.TORCNSTR'
6816 include 'COMMON.CONTROL'
6817 ! 6/20/98 - dihedral angle constraints
6819 c do i=1,ndih_constr
6820 c write (iout,*) "idihconstr_start",idihconstr_start,
6821 c & " idihconstr_end",idihconstr_end
6823 if (raw_psipred) then
6824 do i=idihconstr_start,idihconstr_end
6825 itori=idih_constr(i)
6827 gaudih_i=vpsipred(1,i)
6831 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6832 dexpcos_i=dexp(-cos_i*cos_i)
6833 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6834 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6835 & *cos_i*dexpcos_i/s**2
6837 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6838 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6840 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6841 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6842 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6843 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6844 & -wdihc*dlog(gaudih_i)
6848 do i=idihconstr_start,idihconstr_end
6849 itori=idih_constr(i)
6851 difi=pinorm(phii-phi0(i))
6852 if (difi.gt.drange(i)) then
6854 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6855 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6856 else if (difi.lt.-drange(i)) then
6858 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6859 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6867 c write (iout,*) "ETOR_CONSTR",edihcnstr
6870 c----------------------------------------------------------------------------
6871 C The rigorous attempt to derive energy function
6872 subroutine ebend_kcc(etheta)
6874 implicit real*8 (a-h,o-z)
6875 include 'DIMENSIONS'
6876 include 'DIMENSIONS.ZSCOPT'
6877 include 'COMMON.VAR'
6878 include 'COMMON.GEO'
6879 include 'COMMON.LOCAL'
6880 include 'COMMON.TORSION'
6881 include 'COMMON.INTERACT'
6882 include 'COMMON.DERIV'
6883 include 'COMMON.CHAIN'
6884 include 'COMMON.NAMES'
6885 include 'COMMON.IOUNITS'
6886 include 'COMMON.FFIELD'
6887 include 'COMMON.TORCNSTR'
6888 include 'COMMON.CONTROL'
6890 double precision thybt1(maxang_kcc)
6891 C Set lprn=.true. for debugging
6894 C print *,"wchodze kcc"
6895 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6897 do i=ithet_start,ithet_end
6898 c print *,i,itype(i-1),itype(i),itype(i-2)
6899 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6900 & .or.itype(i).eq.ntyp1) cycle
6901 iti=iabs(itortyp(itype(i-1)))
6902 sinthet=dsin(theta(i))
6903 costhet=dcos(theta(i))
6904 do j=1,nbend_kcc_Tb(iti)
6905 thybt1(j)=v1bend_chyb(j,iti)
6907 sumth1thyb=v1bend_chyb(0,iti)+
6908 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6909 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6911 ihelp=nbend_kcc_Tb(iti)-1
6912 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6913 etheta=etheta+sumth1thyb
6914 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6915 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6919 c-------------------------------------------------------------------------------------
6920 subroutine etheta_constr(ethetacnstr)
6922 implicit real*8 (a-h,o-z)
6923 include 'DIMENSIONS'
6924 include 'DIMENSIONS.ZSCOPT'
6925 include 'COMMON.VAR'
6926 include 'COMMON.GEO'
6927 include 'COMMON.LOCAL'
6928 include 'COMMON.TORSION'
6929 include 'COMMON.INTERACT'
6930 include 'COMMON.DERIV'
6931 include 'COMMON.CHAIN'
6932 include 'COMMON.NAMES'
6933 include 'COMMON.IOUNITS'
6934 include 'COMMON.FFIELD'
6935 include 'COMMON.TORCNSTR'
6936 include 'COMMON.CONTROL'
6938 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6939 do i=ithetaconstr_start,ithetaconstr_end
6940 itheta=itheta_constr(i)
6941 thetiii=theta(itheta)
6942 difi=pinorm(thetiii-theta_constr0(i))
6943 if (difi.gt.theta_drange(i)) then
6944 difi=difi-theta_drange(i)
6945 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6946 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6947 & +for_thet_constr(i)*difi**3
6948 else if (difi.lt.-drange(i)) then
6950 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6951 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6952 & +for_thet_constr(i)*difi**3
6956 if (energy_dec) then
6957 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6958 & i,itheta,rad2deg*thetiii,
6959 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6960 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6961 & gloc(itheta+nphi-2,icg)
6966 c------------------------------------------------------------------------------
6967 c------------------------------------------------------------------------------
6968 subroutine eback_sc_corr(esccor)
6969 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6970 c conformational states; temporarily implemented as differences
6971 c between UNRES torsional potentials (dependent on three types of
6972 c residues) and the torsional potentials dependent on all 20 types
6973 c of residues computed from AM1 energy surfaces of terminally-blocked
6974 c amino-acid residues.
6975 implicit real*8 (a-h,o-z)
6976 include 'DIMENSIONS'
6977 include 'DIMENSIONS.ZSCOPT'
6978 include 'COMMON.VAR'
6979 include 'COMMON.GEO'
6980 include 'COMMON.LOCAL'
6981 include 'COMMON.TORSION'
6982 include 'COMMON.SCCOR'
6983 include 'COMMON.INTERACT'
6984 include 'COMMON.DERIV'
6985 include 'COMMON.CHAIN'
6986 include 'COMMON.NAMES'
6987 include 'COMMON.IOUNITS'
6988 include 'COMMON.FFIELD'
6989 include 'COMMON.CONTROL'
6991 C Set lprn=.true. for debugging
6994 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6996 do i=itau_start,itau_end
6997 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6999 isccori=isccortyp(itype(i-2))
7000 isccori1=isccortyp(itype(i-1))
7002 do intertyp=1,3 !intertyp
7003 cc Added 09 May 2012 (Adasko)
7004 cc Intertyp means interaction type of backbone mainchain correlation:
7005 c 1 = SC...Ca...Ca...Ca
7006 c 2 = Ca...Ca...Ca...SC
7007 c 3 = SC...Ca...Ca...SCi
7009 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7010 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7011 & (itype(i-1).eq.ntyp1)))
7012 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7013 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7014 & .or.(itype(i).eq.ntyp1)))
7015 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7016 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7017 & (itype(i-3).eq.ntyp1)))) cycle
7018 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7019 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7021 do j=1,nterm_sccor(isccori,isccori1)
7022 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7023 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7024 cosphi=dcos(j*tauangle(intertyp,i))
7025 sinphi=dsin(j*tauangle(intertyp,i))
7026 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7027 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7029 C write (iout,*)"EBACK_SC_COR",esccor,i
7030 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
7031 c & nterm_sccor(isccori,isccori1),isccori,isccori1
7032 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7034 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7035 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7036 & (v1sccor(j,1,itori,itori1),j=1,6)
7037 & ,(v2sccor(j,1,itori,itori1),j=1,6)
7038 c gsccor_loc(i-3)=gloci
7044 c------------------------------------------------------------------------------
7045 subroutine multibody(ecorr)
7046 C This subroutine calculates multi-body contributions to energy following
7047 C the idea of Skolnick et al. If side chains I and J make a contact and
7048 C at the same time side chains I+1 and J+1 make a contact, an extra
7049 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7050 implicit real*8 (a-h,o-z)
7051 include 'DIMENSIONS'
7052 include 'COMMON.IOUNITS'
7053 include 'COMMON.DERIV'
7054 include 'COMMON.INTERACT'
7055 include 'COMMON.CONTACTS'
7056 include 'COMMON.CONTMAT'
7057 include 'COMMON.CORRMAT'
7058 double precision gx(3),gx1(3)
7061 C Set lprn=.true. for debugging
7065 write (iout,'(a)') 'Contact function values:'
7067 write (iout,'(i2,20(1x,i2,f10.5))')
7068 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7083 num_conti=num_cont(i)
7084 num_conti1=num_cont(i1)
7089 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7090 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7091 cd & ' ishift=',ishift
7092 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7093 C The system gains extra energy.
7094 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7095 endif ! j1==j+-ishift
7104 c------------------------------------------------------------------------------
7105 double precision function esccorr(i,j,k,l,jj,kk)
7106 implicit real*8 (a-h,o-z)
7107 include 'DIMENSIONS'
7108 include 'COMMON.IOUNITS'
7109 include 'COMMON.DERIV'
7110 include 'COMMON.INTERACT'
7111 include 'COMMON.CONTACTS'
7112 include 'COMMON.CONTMAT'
7113 include 'COMMON.CORRMAT'
7114 double precision gx(3),gx1(3)
7119 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7120 C Calculate the multi-body contribution to energy.
7121 C Calculate multi-body contributions to the gradient.
7122 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7123 cd & k,l,(gacont(m,kk,k),m=1,3)
7125 gx(m) =ekl*gacont(m,jj,i)
7126 gx1(m)=eij*gacont(m,kk,k)
7127 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7128 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7129 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7130 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7134 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7139 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7145 c------------------------------------------------------------------------------
7146 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7147 C This subroutine calculates multi-body contributions to hydrogen-bonding
7148 implicit real*8 (a-h,o-z)
7149 include 'DIMENSIONS'
7150 include 'DIMENSIONS.ZSCOPT'
7151 include 'COMMON.IOUNITS'
7152 include 'COMMON.FFIELD'
7153 include 'COMMON.DERIV'
7154 include 'COMMON.INTERACT'
7155 include 'COMMON.CONTACTS'
7156 include 'COMMON.CONTMAT'
7157 include 'COMMON.CORRMAT'
7158 double precision gx(3),gx1(3)
7161 C Set lprn=.true. for debugging
7164 write (iout,'(a)') 'Contact function values:'
7166 write (iout,'(2i3,50(1x,i2,f5.2))')
7167 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7168 & j=1,num_cont_hb(i))
7172 C Remove the loop below after debugging !!!
7179 C Calculate the local-electrostatic correlation terms
7180 do i=iatel_s,iatel_e+1
7182 num_conti=num_cont_hb(i)
7183 num_conti1=num_cont_hb(i+1)
7188 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7189 c & ' jj=',jj,' kk=',kk
7190 if (j1.eq.j+1 .or. j1.eq.j-1) then
7191 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7192 C The system gains extra energy.
7193 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7195 else if (j1.eq.j) then
7196 C Contacts I-J and I-(J+1) occur simultaneously.
7197 C The system loses extra energy.
7198 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7203 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7204 c & ' jj=',jj,' kk=',kk
7206 C Contacts I-J and (I+1)-J occur simultaneously.
7207 C The system loses extra energy.
7208 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7215 c------------------------------------------------------------------------------
7216 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7218 C This subroutine calculates multi-body contributions to hydrogen-bonding
7219 implicit real*8 (a-h,o-z)
7220 include 'DIMENSIONS'
7221 include 'DIMENSIONS.ZSCOPT'
7222 include 'COMMON.IOUNITS'
7226 include 'COMMON.FFIELD'
7227 include 'COMMON.DERIV'
7228 include 'COMMON.LOCAL'
7229 include 'COMMON.INTERACT'
7230 include 'COMMON.CONTACTS'
7231 include 'COMMON.CONTMAT'
7232 include 'COMMON.CORRMAT'
7233 include 'COMMON.CHAIN'
7234 include 'COMMON.CONTROL'
7235 include 'COMMON.SHIELD'
7236 double precision gx(3),gx1(3)
7237 integer num_cont_hb_old(maxres)
7239 double precision eello4,eello5,eelo6,eello_turn6
7240 external eello4,eello5,eello6,eello_turn6
7241 C Set lprn=.true. for debugging
7245 write (iout,'(a)') 'Contact function values:'
7247 write (iout,'(2i3,50(1x,i2,5f6.3))')
7248 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7249 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7255 C Remove the loop below after debugging !!!
7262 C Calculate the dipole-dipole interaction energies
7263 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7264 do i=iatel_s,iatel_e+1
7265 num_conti=num_cont_hb(i)
7274 C Calculate the local-electrostatic correlation terms
7275 c write (iout,*) "gradcorr5 in eello5 before loop"
7277 c write (iout,'(i5,3f10.5)')
7278 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7280 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7281 c write (iout,*) "corr loop i",i
7283 num_conti=num_cont_hb(i)
7284 num_conti1=num_cont_hb(i+1)
7291 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7292 c & ' jj=',jj,' kk=',kk
7293 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7294 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7295 & .or. j.lt.0 .and. j1.gt.0) .and.
7296 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7297 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7298 C The system gains extra energy.
7300 sqd1=dsqrt(d_cont(jj,i))
7301 sqd2=dsqrt(d_cont(kk,i1))
7302 sred_geom = sqd1*sqd2
7303 IF (sred_geom.lt.cutoff_corr) THEN
7304 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7306 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7307 cd & ' jj=',jj,' kk=',kk
7308 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7309 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7311 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7312 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7315 cd write (iout,*) 'sred_geom=',sred_geom,
7316 cd & ' ekont=',ekont,' fprim=',fprimcont,
7317 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7318 cd write (iout,*) "g_contij",g_contij
7319 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7320 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7321 call calc_eello(i,jp,i+1,jp1,jj,kk)
7322 if (wcorr4.gt.0.0d0)
7323 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7324 CC & *fac_shield(i)**2*fac_shield(j)**2
7325 if (energy_dec.and.wcorr4.gt.0.0d0)
7326 1 write (iout,'(a6,4i5,0pf7.3)')
7327 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7328 c write (iout,*) "gradcorr5 before eello5"
7330 c write (iout,'(i5,3f10.5)')
7331 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7333 if (wcorr5.gt.0.0d0)
7334 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7335 c write (iout,*) "gradcorr5 after eello5"
7337 c write (iout,'(i5,3f10.5)')
7338 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7340 if (energy_dec.and.wcorr5.gt.0.0d0)
7341 1 write (iout,'(a6,4i5,0pf7.3)')
7342 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7343 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7344 cd write(2,*)'ijkl',i,jp,i+1,jp1
7345 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7346 & .or. wturn6.eq.0.0d0))then
7347 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7348 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7349 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7350 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7351 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7352 cd & 'ecorr6=',ecorr6
7353 cd write (iout,'(4e15.5)') sred_geom,
7354 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7355 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7356 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7357 else if (wturn6.gt.0.0d0
7358 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7359 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7360 eturn6=eturn6+eello_turn6(i,jj,kk)
7361 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7362 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7363 cd write (2,*) 'multibody_eello:eturn6',eturn6
7372 num_cont_hb(i)=num_cont_hb_old(i)
7374 c write (iout,*) "gradcorr5 in eello5"
7376 c write (iout,'(i5,3f10.5)')
7377 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7381 c------------------------------------------------------------------------------
7382 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7383 implicit real*8 (a-h,o-z)
7384 include 'DIMENSIONS'
7385 include 'DIMENSIONS.ZSCOPT'
7386 include 'COMMON.IOUNITS'
7387 include 'COMMON.DERIV'
7388 include 'COMMON.INTERACT'
7389 include 'COMMON.CONTACTS'
7390 include 'COMMON.CONTMAT'
7391 include 'COMMON.CORRMAT'
7392 include 'COMMON.SHIELD'
7393 include 'COMMON.CONTROL'
7394 double precision gx(3),gx1(3)
7397 C print *,"wchodze",fac_shield(i),shield_mode
7405 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7407 C & fac_shield(i)**2*fac_shield(j)**2
7408 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7409 C Following 4 lines for diagnostics.
7414 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7415 c & 'Contacts ',i,j,
7416 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7417 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7419 C Calculate the multi-body contribution to energy.
7420 C ecorr=ecorr+ekont*ees
7421 C Calculate multi-body contributions to the gradient.
7422 coeffpees0pij=coeffp*ees0pij
7423 coeffmees0mij=coeffm*ees0mij
7424 coeffpees0pkl=coeffp*ees0pkl
7425 coeffmees0mkl=coeffm*ees0mkl
7427 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7428 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7429 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7430 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7431 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7432 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7433 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7434 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7435 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7436 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7437 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7438 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7439 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7440 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7441 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7442 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7443 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7444 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7445 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7446 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7447 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7448 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7449 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7450 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7451 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7456 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7457 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7458 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7459 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7464 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7465 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7466 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7467 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7470 c write (iout,*) "ehbcorr",ekont*ees
7471 C print *,ekont,ees,i,k
7473 C now gradient over shielding
7475 if (shield_mode.gt.0) then
7478 C print *,i,j,fac_shield(i),fac_shield(j),
7479 C &fac_shield(k),fac_shield(l)
7480 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
7481 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7482 do ilist=1,ishield_list(i)
7483 iresshield=shield_list(ilist,i)
7485 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7487 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7489 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7490 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7494 do ilist=1,ishield_list(j)
7495 iresshield=shield_list(ilist,j)
7497 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7499 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7501 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7502 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7507 do ilist=1,ishield_list(k)
7508 iresshield=shield_list(ilist,k)
7510 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7512 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7514 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7515 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7519 do ilist=1,ishield_list(l)
7520 iresshield=shield_list(ilist,l)
7522 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7524 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7526 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7527 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7531 C print *,gshieldx(m,iresshield)
7533 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
7534 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7535 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
7536 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7537 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
7538 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7539 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
7540 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7542 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
7543 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7544 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
7545 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7546 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
7547 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7548 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
7549 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7557 C---------------------------------------------------------------------------
7558 subroutine dipole(i,j,jj)
7559 implicit real*8 (a-h,o-z)
7560 include 'DIMENSIONS'
7561 include 'DIMENSIONS.ZSCOPT'
7562 include 'COMMON.IOUNITS'
7563 include 'COMMON.CHAIN'
7564 include 'COMMON.FFIELD'
7565 include 'COMMON.DERIV'
7566 include 'COMMON.INTERACT'
7567 include 'COMMON.CONTACTS'
7568 include 'COMMON.CONTMAT'
7569 include 'COMMON.CORRMAT'
7570 include 'COMMON.TORSION'
7571 include 'COMMON.VAR'
7572 include 'COMMON.GEO'
7573 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7575 iti1 = itortyp(itype(i+1))
7576 if (j.lt.nres-1) then
7577 itj1 = itype2loc(itype(j+1))
7582 dipi(iii,1)=Ub2(iii,i)
7583 dipderi(iii)=Ub2der(iii,i)
7584 dipi(iii,2)=b1(iii,i+1)
7585 dipj(iii,1)=Ub2(iii,j)
7586 dipderj(iii)=Ub2der(iii,j)
7587 dipj(iii,2)=b1(iii,j+1)
7591 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7594 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7601 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7605 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7610 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7611 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7613 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7615 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7617 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7622 C---------------------------------------------------------------------------
7623 subroutine calc_eello(i,j,k,l,jj,kk)
7625 C This subroutine computes matrices and vectors needed to calculate
7626 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7628 implicit real*8 (a-h,o-z)
7629 include 'DIMENSIONS'
7630 include 'DIMENSIONS.ZSCOPT'
7631 include 'COMMON.IOUNITS'
7632 include 'COMMON.CHAIN'
7633 include 'COMMON.DERIV'
7634 include 'COMMON.INTERACT'
7635 include 'COMMON.CONTACTS'
7636 include 'COMMON.CONTMAT'
7637 include 'COMMON.CORRMAT'
7638 include 'COMMON.TORSION'
7639 include 'COMMON.VAR'
7640 include 'COMMON.GEO'
7641 include 'COMMON.FFIELD'
7642 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7643 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7646 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7647 cd & ' jj=',jj,' kk=',kk
7648 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7649 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7650 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7653 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7654 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7657 call transpose2(aa1(1,1),aa1t(1,1))
7658 call transpose2(aa2(1,1),aa2t(1,1))
7661 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7662 & aa1tder(1,1,lll,kkk))
7663 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7664 & aa2tder(1,1,lll,kkk))
7668 C parallel orientation of the two CA-CA-CA frames.
7670 iti=itype2loc(itype(i))
7674 itk1=itype2loc(itype(k+1))
7675 itj=itype2loc(itype(j))
7676 if (l.lt.nres-1) then
7677 itl1=itype2loc(itype(l+1))
7681 C A1 kernel(j+1) A2T
7683 cd write (iout,'(3f10.5,5x,3f10.5)')
7684 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7686 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7687 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7688 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7689 C Following matrices are needed only for 6-th order cumulants
7690 IF (wcorr6.gt.0.0d0) THEN
7691 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7692 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7693 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7694 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7695 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7696 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7697 & ADtEAderx(1,1,1,1,1,1))
7699 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7700 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7701 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7702 & ADtEA1derx(1,1,1,1,1,1))
7704 C End 6-th order cumulants
7707 cd write (2,*) 'In calc_eello6'
7709 cd write (2,*) 'iii=',iii
7711 cd write (2,*) 'kkk=',kkk
7713 cd write (2,'(3(2f10.5),5x)')
7714 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7719 call transpose2(EUgder(1,1,k),auxmat(1,1))
7720 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7721 call transpose2(EUg(1,1,k),auxmat(1,1))
7722 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7723 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7727 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7728 & EAEAderx(1,1,lll,kkk,iii,1))
7732 C A1T kernel(i+1) A2
7733 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7734 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7735 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7736 C Following matrices are needed only for 6-th order cumulants
7737 IF (wcorr6.gt.0.0d0) THEN
7738 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7739 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7740 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7741 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7742 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7743 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7744 & ADtEAderx(1,1,1,1,1,2))
7745 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7746 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7747 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7748 & ADtEA1derx(1,1,1,1,1,2))
7750 C End 6-th order cumulants
7751 call transpose2(EUgder(1,1,l),auxmat(1,1))
7752 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7753 call transpose2(EUg(1,1,l),auxmat(1,1))
7754 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7755 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7759 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7760 & EAEAderx(1,1,lll,kkk,iii,2))
7765 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7766 C They are needed only when the fifth- or the sixth-order cumulants are
7768 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7769 call transpose2(AEA(1,1,1),auxmat(1,1))
7770 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7771 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7772 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7773 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7774 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7775 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7776 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7777 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7778 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7779 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7780 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7781 call transpose2(AEA(1,1,2),auxmat(1,1))
7782 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7783 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7784 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7785 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7786 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7787 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7788 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7789 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7790 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7791 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7792 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7793 C Calculate the Cartesian derivatives of the vectors.
7797 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7798 call matvec2(auxmat(1,1),b1(1,i),
7799 & AEAb1derx(1,lll,kkk,iii,1,1))
7800 call matvec2(auxmat(1,1),Ub2(1,i),
7801 & AEAb2derx(1,lll,kkk,iii,1,1))
7802 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7803 & AEAb1derx(1,lll,kkk,iii,2,1))
7804 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7805 & AEAb2derx(1,lll,kkk,iii,2,1))
7806 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7807 call matvec2(auxmat(1,1),b1(1,j),
7808 & AEAb1derx(1,lll,kkk,iii,1,2))
7809 call matvec2(auxmat(1,1),Ub2(1,j),
7810 & AEAb2derx(1,lll,kkk,iii,1,2))
7811 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7812 & AEAb1derx(1,lll,kkk,iii,2,2))
7813 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7814 & AEAb2derx(1,lll,kkk,iii,2,2))
7821 C Antiparallel orientation of the two CA-CA-CA frames.
7823 iti=itype2loc(itype(i))
7827 itk1=itype2loc(itype(k+1))
7828 itl=itype2loc(itype(l))
7829 itj=itype2loc(itype(j))
7830 if (j.lt.nres-1) then
7831 itj1=itype2loc(itype(j+1))
7835 C A2 kernel(j-1)T A1T
7836 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7837 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7838 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7839 C Following matrices are needed only for 6-th order cumulants
7840 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7841 & j.eq.i+4 .and. l.eq.i+3)) THEN
7842 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7843 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7844 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7845 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7846 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7847 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7848 & ADtEAderx(1,1,1,1,1,1))
7849 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7850 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7851 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7852 & ADtEA1derx(1,1,1,1,1,1))
7854 C End 6-th order cumulants
7855 call transpose2(EUgder(1,1,k),auxmat(1,1))
7856 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7857 call transpose2(EUg(1,1,k),auxmat(1,1))
7858 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7859 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7863 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7864 & EAEAderx(1,1,lll,kkk,iii,1))
7868 C A2T kernel(i+1)T A1
7869 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7870 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7871 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7872 C Following matrices are needed only for 6-th order cumulants
7873 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7874 & j.eq.i+4 .and. l.eq.i+3)) THEN
7875 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7876 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7877 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7878 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7879 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7880 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7881 & ADtEAderx(1,1,1,1,1,2))
7882 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7883 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7884 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7885 & ADtEA1derx(1,1,1,1,1,2))
7887 C End 6-th order cumulants
7888 call transpose2(EUgder(1,1,j),auxmat(1,1))
7889 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7890 call transpose2(EUg(1,1,j),auxmat(1,1))
7891 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7892 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7896 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7897 & EAEAderx(1,1,lll,kkk,iii,2))
7902 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7903 C They are needed only when the fifth- or the sixth-order cumulants are
7905 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7906 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7907 call transpose2(AEA(1,1,1),auxmat(1,1))
7908 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7909 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7910 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7911 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7912 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7913 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7914 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7915 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7916 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7917 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7918 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7919 call transpose2(AEA(1,1,2),auxmat(1,1))
7920 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7921 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7922 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7923 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7924 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7925 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7926 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7927 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7928 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7929 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7930 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7931 C Calculate the Cartesian derivatives of the vectors.
7935 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7936 call matvec2(auxmat(1,1),b1(1,i),
7937 & AEAb1derx(1,lll,kkk,iii,1,1))
7938 call matvec2(auxmat(1,1),Ub2(1,i),
7939 & AEAb2derx(1,lll,kkk,iii,1,1))
7940 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7941 & AEAb1derx(1,lll,kkk,iii,2,1))
7942 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7943 & AEAb2derx(1,lll,kkk,iii,2,1))
7944 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7945 call matvec2(auxmat(1,1),b1(1,l),
7946 & AEAb1derx(1,lll,kkk,iii,1,2))
7947 call matvec2(auxmat(1,1),Ub2(1,l),
7948 & AEAb2derx(1,lll,kkk,iii,1,2))
7949 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7950 & AEAb1derx(1,lll,kkk,iii,2,2))
7951 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7952 & AEAb2derx(1,lll,kkk,iii,2,2))
7961 C---------------------------------------------------------------------------
7962 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7963 & KK,KKderg,AKA,AKAderg,AKAderx)
7967 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7968 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7969 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7974 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7976 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7979 cd if (lprn) write (2,*) 'In kernel'
7981 cd if (lprn) write (2,*) 'kkk=',kkk
7983 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7984 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7986 cd write (2,*) 'lll=',lll
7987 cd write (2,*) 'iii=1'
7989 cd write (2,'(3(2f10.5),5x)')
7990 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7993 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7994 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7996 cd write (2,*) 'lll=',lll
7997 cd write (2,*) 'iii=2'
7999 cd write (2,'(3(2f10.5),5x)')
8000 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8007 C---------------------------------------------------------------------------
8008 double precision function eello4(i,j,k,l,jj,kk)
8009 implicit real*8 (a-h,o-z)
8010 include 'DIMENSIONS'
8011 include 'DIMENSIONS.ZSCOPT'
8012 include 'COMMON.IOUNITS'
8013 include 'COMMON.CHAIN'
8014 include 'COMMON.DERIV'
8015 include 'COMMON.INTERACT'
8016 include 'COMMON.CONTACTS'
8017 include 'COMMON.CONTMAT'
8018 include 'COMMON.CORRMAT'
8019 include 'COMMON.TORSION'
8020 include 'COMMON.VAR'
8021 include 'COMMON.GEO'
8022 double precision pizda(2,2),ggg1(3),ggg2(3)
8023 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8027 cd print *,'eello4:',i,j,k,l,jj,kk
8028 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8029 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8030 cold eij=facont_hb(jj,i)
8031 cold ekl=facont_hb(kk,k)
8033 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8035 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8036 gcorr_loc(k-1)=gcorr_loc(k-1)
8037 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8039 gcorr_loc(l-1)=gcorr_loc(l-1)
8040 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8042 gcorr_loc(j-1)=gcorr_loc(j-1)
8043 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8048 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8049 & -EAEAderx(2,2,lll,kkk,iii,1)
8050 cd derx(lll,kkk,iii)=0.0d0
8054 cd gcorr_loc(l-1)=0.0d0
8055 cd gcorr_loc(j-1)=0.0d0
8056 cd gcorr_loc(k-1)=0.0d0
8058 cd write (iout,*)'Contacts have occurred for peptide groups',
8059 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8060 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8061 if (j.lt.nres-1) then
8068 if (l.lt.nres-1) then
8076 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8077 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8078 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8079 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8080 cgrad ghalf=0.5d0*ggg1(ll)
8081 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8082 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8083 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8084 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8085 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8086 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8087 cgrad ghalf=0.5d0*ggg2(ll)
8088 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8089 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8090 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8091 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8092 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8093 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8097 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8102 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8107 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8112 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8116 cd write (2,*) iii,gcorr_loc(iii)
8120 cd write (2,*) 'ekont',ekont
8121 cd write (iout,*) 'eello4',ekont*eel4
8124 C---------------------------------------------------------------------------
8125 double precision function eello5(i,j,k,l,jj,kk)
8126 implicit real*8 (a-h,o-z)
8127 include 'DIMENSIONS'
8128 include 'DIMENSIONS.ZSCOPT'
8129 include 'COMMON.IOUNITS'
8130 include 'COMMON.CHAIN'
8131 include 'COMMON.DERIV'
8132 include 'COMMON.INTERACT'
8133 include 'COMMON.CONTACTS'
8134 include 'COMMON.CONTMAT'
8135 include 'COMMON.CORRMAT'
8136 include 'COMMON.TORSION'
8137 include 'COMMON.VAR'
8138 include 'COMMON.GEO'
8139 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8140 double precision ggg1(3),ggg2(3)
8141 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8146 C /l\ / \ \ / \ / \ / C
8147 C / \ / \ \ / \ / \ / C
8148 C j| o |l1 | o | o| o | | o |o C
8149 C \ |/k\| |/ \| / |/ \| |/ \| C
8150 C \i/ \ / \ / / \ / \ C
8152 C (I) (II) (III) (IV) C
8154 C eello5_1 eello5_2 eello5_3 eello5_4 C
8156 C Antiparallel chains C
8159 C /j\ / \ \ / \ / \ / C
8160 C / \ / \ \ / \ / \ / C
8161 C j1| o |l | o | o| o | | o |o C
8162 C \ |/k\| |/ \| / |/ \| |/ \| C
8163 C \i/ \ / \ / / \ / \ C
8165 C (I) (II) (III) (IV) C
8167 C eello5_1 eello5_2 eello5_3 eello5_4 C
8169 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8171 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8172 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8177 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8179 itk=itype2loc(itype(k))
8180 itl=itype2loc(itype(l))
8181 itj=itype2loc(itype(j))
8186 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8187 cd & eel5_3_num,eel5_4_num)
8191 derx(lll,kkk,iii)=0.0d0
8195 cd eij=facont_hb(jj,i)
8196 cd ekl=facont_hb(kk,k)
8198 cd write (iout,*)'Contacts have occurred for peptide groups',
8199 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8201 C Contribution from the graph I.
8202 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8203 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8204 call transpose2(EUg(1,1,k),auxmat(1,1))
8205 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8206 vv(1)=pizda(1,1)-pizda(2,2)
8207 vv(2)=pizda(1,2)+pizda(2,1)
8208 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8209 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8211 C Explicit gradient in virtual-dihedral angles.
8212 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8213 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8214 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8215 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8216 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8217 vv(1)=pizda(1,1)-pizda(2,2)
8218 vv(2)=pizda(1,2)+pizda(2,1)
8219 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8220 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8221 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8222 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8223 vv(1)=pizda(1,1)-pizda(2,2)
8224 vv(2)=pizda(1,2)+pizda(2,1)
8226 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8227 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8228 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8230 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8231 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8232 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8234 C Cartesian gradient
8238 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8240 vv(1)=pizda(1,1)-pizda(2,2)
8241 vv(2)=pizda(1,2)+pizda(2,1)
8242 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8243 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8244 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8251 C Contribution from graph II
8252 call transpose2(EE(1,1,k),auxmat(1,1))
8253 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8254 vv(1)=pizda(1,1)+pizda(2,2)
8255 vv(2)=pizda(2,1)-pizda(1,2)
8256 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8257 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8259 C Explicit gradient in virtual-dihedral angles.
8260 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8261 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8262 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8263 vv(1)=pizda(1,1)+pizda(2,2)
8264 vv(2)=pizda(2,1)-pizda(1,2)
8266 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8267 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8268 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8270 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8271 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8272 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8274 C Cartesian gradient
8278 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8280 vv(1)=pizda(1,1)+pizda(2,2)
8281 vv(2)=pizda(2,1)-pizda(1,2)
8282 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8283 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8284 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8293 C Parallel orientation
8294 C Contribution from graph III
8295 call transpose2(EUg(1,1,l),auxmat(1,1))
8296 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8297 vv(1)=pizda(1,1)-pizda(2,2)
8298 vv(2)=pizda(1,2)+pizda(2,1)
8299 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8300 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8302 C Explicit gradient in virtual-dihedral angles.
8303 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8304 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8305 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8306 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8307 vv(1)=pizda(1,1)-pizda(2,2)
8308 vv(2)=pizda(1,2)+pizda(2,1)
8309 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8310 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8311 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8312 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8313 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8314 vv(1)=pizda(1,1)-pizda(2,2)
8315 vv(2)=pizda(1,2)+pizda(2,1)
8316 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8317 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8318 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8319 C Cartesian gradient
8323 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8325 vv(1)=pizda(1,1)-pizda(2,2)
8326 vv(2)=pizda(1,2)+pizda(2,1)
8327 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8328 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8329 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8334 C Contribution from graph IV
8336 call transpose2(EE(1,1,l),auxmat(1,1))
8337 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8338 vv(1)=pizda(1,1)+pizda(2,2)
8339 vv(2)=pizda(2,1)-pizda(1,2)
8340 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8341 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8342 C Explicit gradient in virtual-dihedral angles.
8343 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8344 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8345 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8346 vv(1)=pizda(1,1)+pizda(2,2)
8347 vv(2)=pizda(2,1)-pizda(1,2)
8348 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8349 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8350 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8351 C Cartesian gradient
8355 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8357 vv(1)=pizda(1,1)+pizda(2,2)
8358 vv(2)=pizda(2,1)-pizda(1,2)
8359 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8360 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8361 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8367 C Antiparallel orientation
8368 C Contribution from graph III
8370 call transpose2(EUg(1,1,j),auxmat(1,1))
8371 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8372 vv(1)=pizda(1,1)-pizda(2,2)
8373 vv(2)=pizda(1,2)+pizda(2,1)
8374 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8375 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8377 C Explicit gradient in virtual-dihedral angles.
8378 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8379 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8380 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8381 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8382 vv(1)=pizda(1,1)-pizda(2,2)
8383 vv(2)=pizda(1,2)+pizda(2,1)
8384 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8385 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8386 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8387 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8388 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8389 vv(1)=pizda(1,1)-pizda(2,2)
8390 vv(2)=pizda(1,2)+pizda(2,1)
8391 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8392 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8393 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8394 C Cartesian gradient
8398 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8400 vv(1)=pizda(1,1)-pizda(2,2)
8401 vv(2)=pizda(1,2)+pizda(2,1)
8402 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8403 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8404 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8410 C Contribution from graph IV
8412 call transpose2(EE(1,1,j),auxmat(1,1))
8413 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8414 vv(1)=pizda(1,1)+pizda(2,2)
8415 vv(2)=pizda(2,1)-pizda(1,2)
8416 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8417 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8419 C Explicit gradient in virtual-dihedral angles.
8420 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8421 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8422 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8423 vv(1)=pizda(1,1)+pizda(2,2)
8424 vv(2)=pizda(2,1)-pizda(1,2)
8425 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8426 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8427 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8428 C Cartesian gradient
8432 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8434 vv(1)=pizda(1,1)+pizda(2,2)
8435 vv(2)=pizda(2,1)-pizda(1,2)
8436 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8437 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8438 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8445 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8446 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8447 cd write (2,*) 'ijkl',i,j,k,l
8448 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8449 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8451 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8452 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8453 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8454 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8456 if (j.lt.nres-1) then
8463 if (l.lt.nres-1) then
8473 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8474 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8475 C summed up outside the subrouine as for the other subroutines
8476 C handling long-range interactions. The old code is commented out
8477 C with "cgrad" to keep track of changes.
8479 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8480 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8481 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8482 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8483 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8484 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8485 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8486 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8487 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8488 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8490 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8491 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8492 cgrad ghalf=0.5d0*ggg1(ll)
8494 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8495 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8496 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8497 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8498 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8499 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8500 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8501 cgrad ghalf=0.5d0*ggg2(ll)
8503 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
8504 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8505 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
8506 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8507 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8508 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8514 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8515 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8520 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8521 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8527 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8532 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8536 cd write (2,*) iii,g_corr5_loc(iii)
8539 cd write (2,*) 'ekont',ekont
8540 cd write (iout,*) 'eello5',ekont*eel5
8543 c--------------------------------------------------------------------------
8544 double precision function eello6(i,j,k,l,jj,kk)
8545 implicit real*8 (a-h,o-z)
8546 include 'DIMENSIONS'
8547 include 'DIMENSIONS.ZSCOPT'
8548 include 'COMMON.IOUNITS'
8549 include 'COMMON.CHAIN'
8550 include 'COMMON.DERIV'
8551 include 'COMMON.INTERACT'
8552 include 'COMMON.CONTACTS'
8553 include 'COMMON.CONTMAT'
8554 include 'COMMON.CORRMAT'
8555 include 'COMMON.TORSION'
8556 include 'COMMON.VAR'
8557 include 'COMMON.GEO'
8558 include 'COMMON.FFIELD'
8559 double precision ggg1(3),ggg2(3)
8560 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8565 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8573 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8574 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8578 derx(lll,kkk,iii)=0.0d0
8582 cd eij=facont_hb(jj,i)
8583 cd ekl=facont_hb(kk,k)
8589 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8590 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8591 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8592 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8593 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8594 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8596 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8597 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8598 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8599 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8600 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8601 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8605 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8607 C If turn contributions are considered, they will be handled separately.
8608 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8609 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8610 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8611 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8612 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8613 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8614 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8617 if (j.lt.nres-1) then
8624 if (l.lt.nres-1) then
8632 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8633 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8634 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8635 cgrad ghalf=0.5d0*ggg1(ll)
8637 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8638 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8639 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8640 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8641 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8642 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8643 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8644 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8645 cgrad ghalf=0.5d0*ggg2(ll)
8646 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8648 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8649 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8650 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8651 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8652 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8653 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8659 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8660 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8665 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8666 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8672 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8677 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8681 cd write (2,*) iii,g_corr6_loc(iii)
8684 cd write (2,*) 'ekont',ekont
8685 cd write (iout,*) 'eello6',ekont*eel6
8688 c--------------------------------------------------------------------------
8689 double precision function eello6_graph1(i,j,k,l,imat,swap)
8690 implicit real*8 (a-h,o-z)
8691 include 'DIMENSIONS'
8692 include 'DIMENSIONS.ZSCOPT'
8693 include 'COMMON.IOUNITS'
8694 include 'COMMON.CHAIN'
8695 include 'COMMON.DERIV'
8696 include 'COMMON.INTERACT'
8697 include 'COMMON.CONTACTS'
8698 include 'COMMON.CONTMAT'
8699 include 'COMMON.CORRMAT'
8700 include 'COMMON.TORSION'
8701 include 'COMMON.VAR'
8702 include 'COMMON.GEO'
8703 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8707 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8709 C Parallel Antiparallel C
8715 C \ j|/k\| / \ |/k\|l / C
8720 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8721 itk=itype2loc(itype(k))
8722 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8723 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8724 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8725 call transpose2(EUgC(1,1,k),auxmat(1,1))
8726 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8727 vv1(1)=pizda1(1,1)-pizda1(2,2)
8728 vv1(2)=pizda1(1,2)+pizda1(2,1)
8729 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8730 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8731 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8732 s5=scalar2(vv(1),Dtobr2(1,i))
8733 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8734 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8736 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8737 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8738 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8739 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8740 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8741 & +scalar2(vv(1),Dtobr2der(1,i)))
8742 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8743 vv1(1)=pizda1(1,1)-pizda1(2,2)
8744 vv1(2)=pizda1(1,2)+pizda1(2,1)
8745 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8746 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8748 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8749 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8750 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8751 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8752 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8754 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8755 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8756 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8757 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8758 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8760 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8761 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8762 vv1(1)=pizda1(1,1)-pizda1(2,2)
8763 vv1(2)=pizda1(1,2)+pizda1(2,1)
8764 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8765 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8766 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8767 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8776 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8777 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8778 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8779 call transpose2(EUgC(1,1,k),auxmat(1,1))
8780 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8782 vv1(1)=pizda1(1,1)-pizda1(2,2)
8783 vv1(2)=pizda1(1,2)+pizda1(2,1)
8784 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8785 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8786 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8787 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8788 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8789 s5=scalar2(vv(1),Dtobr2(1,i))
8790 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8797 c----------------------------------------------------------------------------
8798 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8799 implicit real*8 (a-h,o-z)
8800 include 'DIMENSIONS'
8801 include 'DIMENSIONS.ZSCOPT'
8802 include 'COMMON.IOUNITS'
8803 include 'COMMON.CHAIN'
8804 include 'COMMON.DERIV'
8805 include 'COMMON.INTERACT'
8806 include 'COMMON.CONTACTS'
8807 include 'COMMON.CONTMAT'
8808 include 'COMMON.CORRMAT'
8809 include 'COMMON.TORSION'
8810 include 'COMMON.VAR'
8811 include 'COMMON.GEO'
8813 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8814 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8817 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8819 C Parallel Antiparallel C
8825 C \ j|/k\| \ |/k\|l C
8830 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8831 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8832 C AL 7/4/01 s1 would occur in the sixth-order moment,
8833 C but not in a cluster cumulant
8835 s1=dip(1,jj,i)*dip(1,kk,k)
8837 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8838 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8839 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8840 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8841 call transpose2(EUg(1,1,k),auxmat(1,1))
8842 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8843 vv(1)=pizda(1,1)-pizda(2,2)
8844 vv(2)=pizda(1,2)+pizda(2,1)
8845 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8846 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8848 eello6_graph2=-(s1+s2+s3+s4)
8850 eello6_graph2=-(s2+s3+s4)
8853 C Derivatives in gamma(i-1)
8857 s1=dipderg(1,jj,i)*dip(1,kk,k)
8859 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8860 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8861 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8862 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8864 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8866 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8868 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8870 C Derivatives in gamma(k-1)
8872 s1=dip(1,jj,i)*dipderg(1,kk,k)
8874 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8875 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8876 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8877 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8878 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8879 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8880 vv(1)=pizda(1,1)-pizda(2,2)
8881 vv(2)=pizda(1,2)+pizda(2,1)
8882 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8884 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8886 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8888 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8889 C Derivatives in gamma(j-1) or gamma(l-1)
8892 s1=dipderg(3,jj,i)*dip(1,kk,k)
8894 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8895 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8896 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8897 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8898 vv(1)=pizda(1,1)-pizda(2,2)
8899 vv(2)=pizda(1,2)+pizda(2,1)
8900 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8903 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8905 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8908 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8909 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8911 C Derivatives in gamma(l-1) or gamma(j-1)
8914 s1=dip(1,jj,i)*dipderg(3,kk,k)
8916 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8917 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8918 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8919 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8920 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8921 vv(1)=pizda(1,1)-pizda(2,2)
8922 vv(2)=pizda(1,2)+pizda(2,1)
8923 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8926 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8928 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8931 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8932 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8934 C Cartesian derivatives.
8936 write (2,*) 'In eello6_graph2'
8938 write (2,*) 'iii=',iii
8940 write (2,*) 'kkk=',kkk
8942 write (2,'(3(2f10.5),5x)')
8943 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8953 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8955 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8958 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8960 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8961 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8963 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8964 call transpose2(EUg(1,1,k),auxmat(1,1))
8965 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8967 vv(1)=pizda(1,1)-pizda(2,2)
8968 vv(2)=pizda(1,2)+pizda(2,1)
8969 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8970 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8972 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8974 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8977 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8979 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8987 c----------------------------------------------------------------------------
8988 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8989 implicit real*8 (a-h,o-z)
8990 include 'DIMENSIONS'
8991 include 'DIMENSIONS.ZSCOPT'
8992 include 'COMMON.IOUNITS'
8993 include 'COMMON.CHAIN'
8994 include 'COMMON.DERIV'
8995 include 'COMMON.INTERACT'
8996 include 'COMMON.CONTACTS'
8997 include 'COMMON.CONTMAT'
8998 include 'COMMON.CORRMAT'
8999 include 'COMMON.TORSION'
9000 include 'COMMON.VAR'
9001 include 'COMMON.GEO'
9002 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9004 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9006 C Parallel Antiparallel C
9012 C j|/k\| / |/k\|l / C
9017 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9019 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9020 C energy moment and not to the cluster cumulant.
9021 iti=itortyp(itype(i))
9022 if (j.lt.nres-1) then
9023 itj1=itype2loc(itype(j+1))
9027 itk=itype2loc(itype(k))
9028 itk1=itype2loc(itype(k+1))
9029 if (l.lt.nres-1) then
9030 itl1=itype2loc(itype(l+1))
9035 s1=dip(4,jj,i)*dip(4,kk,k)
9037 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9038 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9039 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9040 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9041 call transpose2(EE(1,1,k),auxmat(1,1))
9042 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9043 vv(1)=pizda(1,1)+pizda(2,2)
9044 vv(2)=pizda(2,1)-pizda(1,2)
9045 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9046 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9047 cd & "sum",-(s2+s3+s4)
9049 eello6_graph3=-(s1+s2+s3+s4)
9051 eello6_graph3=-(s2+s3+s4)
9054 C Derivatives in gamma(k-1)
9056 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9057 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9058 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9059 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9060 C Derivatives in gamma(l-1)
9061 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9062 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9063 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9064 vv(1)=pizda(1,1)+pizda(2,2)
9065 vv(2)=pizda(2,1)-pizda(1,2)
9066 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9067 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9068 C Cartesian derivatives.
9074 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9076 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9079 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9081 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9082 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9084 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9085 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9087 vv(1)=pizda(1,1)+pizda(2,2)
9088 vv(2)=pizda(2,1)-pizda(1,2)
9089 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9091 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9093 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9096 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9098 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9100 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9107 c----------------------------------------------------------------------------
9108 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9109 implicit real*8 (a-h,o-z)
9110 include 'DIMENSIONS'
9111 include 'DIMENSIONS.ZSCOPT'
9112 include 'COMMON.IOUNITS'
9113 include 'COMMON.CHAIN'
9114 include 'COMMON.DERIV'
9115 include 'COMMON.INTERACT'
9116 include 'COMMON.CONTACTS'
9117 include 'COMMON.CONTMAT'
9118 include 'COMMON.CORRMAT'
9119 include 'COMMON.TORSION'
9120 include 'COMMON.VAR'
9121 include 'COMMON.GEO'
9122 include 'COMMON.FFIELD'
9123 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9124 & auxvec1(2),auxmat1(2,2)
9126 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9128 C Parallel Antiparallel C
9134 C \ j|/k\| \ |/k\|l C
9139 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9141 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9142 C energy moment and not to the cluster cumulant.
9143 cd write (2,*) 'eello_graph4: wturn6',wturn6
9144 iti=itype2loc(itype(i))
9145 itj=itype2loc(itype(j))
9146 if (j.lt.nres-1) then
9147 itj1=itype2loc(itype(j+1))
9151 itk=itype2loc(itype(k))
9152 if (k.lt.nres-1) then
9153 itk1=itype2loc(itype(k+1))
9157 itl=itype2loc(itype(l))
9158 if (l.lt.nres-1) then
9159 itl1=itype2loc(itype(l+1))
9163 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9164 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9165 cd & ' itl',itl,' itl1',itl1
9168 s1=dip(3,jj,i)*dip(3,kk,k)
9170 s1=dip(2,jj,j)*dip(2,kk,l)
9173 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9174 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9176 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9177 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9179 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9180 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9182 call transpose2(EUg(1,1,k),auxmat(1,1))
9183 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9184 vv(1)=pizda(1,1)-pizda(2,2)
9185 vv(2)=pizda(2,1)+pizda(1,2)
9186 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9187 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9189 eello6_graph4=-(s1+s2+s3+s4)
9191 eello6_graph4=-(s2+s3+s4)
9193 C Derivatives in gamma(i-1)
9198 s1=dipderg(2,jj,i)*dip(3,kk,k)
9200 s1=dipderg(4,jj,j)*dip(2,kk,l)
9203 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9205 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9206 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9208 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9209 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9211 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9212 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9213 cd write (2,*) 'turn6 derivatives'
9215 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9217 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9221 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9223 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9227 C Derivatives in gamma(k-1)
9230 s1=dip(3,jj,i)*dipderg(2,kk,k)
9232 s1=dip(2,jj,j)*dipderg(4,kk,l)
9235 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9236 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9238 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9239 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9241 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9242 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9244 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9245 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9246 vv(1)=pizda(1,1)-pizda(2,2)
9247 vv(2)=pizda(2,1)+pizda(1,2)
9248 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9249 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9251 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9253 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9257 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9259 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9262 C Derivatives in gamma(j-1) or gamma(l-1)
9263 if (l.eq.j+1 .and. l.gt.1) then
9264 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9265 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9266 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9267 vv(1)=pizda(1,1)-pizda(2,2)
9268 vv(2)=pizda(2,1)+pizda(1,2)
9269 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9270 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9271 else if (j.gt.1) then
9272 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9273 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9274 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9275 vv(1)=pizda(1,1)-pizda(2,2)
9276 vv(2)=pizda(2,1)+pizda(1,2)
9277 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9278 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9279 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9281 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9284 C Cartesian derivatives.
9291 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9293 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9297 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9299 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9303 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9305 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9307 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9308 & b1(1,j+1),auxvec(1))
9309 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9311 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9312 & b1(1,l+1),auxvec(1))
9313 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9315 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9317 vv(1)=pizda(1,1)-pizda(2,2)
9318 vv(2)=pizda(2,1)+pizda(1,2)
9319 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9321 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9323 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9326 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9329 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9332 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9334 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9336 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9340 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9342 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9345 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9347 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9356 c----------------------------------------------------------------------------
9357 double precision function eello_turn6(i,jj,kk)
9358 implicit real*8 (a-h,o-z)
9359 include 'DIMENSIONS'
9360 include 'DIMENSIONS.ZSCOPT'
9361 include 'COMMON.IOUNITS'
9362 include 'COMMON.CHAIN'
9363 include 'COMMON.DERIV'
9364 include 'COMMON.INTERACT'
9365 include 'COMMON.CONTACTS'
9366 include 'COMMON.CONTMAT'
9367 include 'COMMON.CORRMAT'
9368 include 'COMMON.TORSION'
9369 include 'COMMON.VAR'
9370 include 'COMMON.GEO'
9371 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9372 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9374 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9375 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9376 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9377 C the respective energy moment and not to the cluster cumulant.
9386 iti=itype2loc(itype(i))
9387 itk=itype2loc(itype(k))
9388 itk1=itype2loc(itype(k+1))
9389 itl=itype2loc(itype(l))
9390 itj=itype2loc(itype(j))
9391 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9392 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9393 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9398 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9400 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9404 derx_turn(lll,kkk,iii)=0.0d0
9411 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9413 cd write (2,*) 'eello6_5',eello6_5
9415 call transpose2(AEA(1,1,1),auxmat(1,1))
9416 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9417 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9418 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9420 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9421 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9422 s2 = scalar2(b1(1,k),vtemp1(1))
9424 call transpose2(AEA(1,1,2),atemp(1,1))
9425 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9426 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
9427 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9429 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9430 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9431 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9433 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9434 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9435 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9436 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9437 ss13 = scalar2(b1(1,k),vtemp4(1))
9438 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9440 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9446 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9447 C Derivatives in gamma(i+2)
9452 call transpose2(AEA(1,1,1),auxmatd(1,1))
9453 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9454 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9455 call transpose2(AEAderg(1,1,2),atempd(1,1))
9456 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9457 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9459 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9460 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9461 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9467 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9468 C Derivatives in gamma(i+3)
9470 call transpose2(AEA(1,1,1),auxmatd(1,1))
9471 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9472 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9473 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9475 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9476 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9477 s2d = scalar2(b1(1,k),vtemp1d(1))
9479 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
9480 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
9482 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9484 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9485 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9486 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9494 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9495 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9497 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9498 & -0.5d0*ekont*(s2d+s12d)
9500 C Derivatives in gamma(i+4)
9501 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9502 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9503 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9505 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9506 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9507 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9515 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9517 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9519 C Derivatives in gamma(i+5)
9521 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9522 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9523 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9525 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9526 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9527 s2d = scalar2(b1(1,k),vtemp1d(1))
9529 call transpose2(AEA(1,1,2),atempd(1,1))
9530 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9531 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9533 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9534 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9536 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9537 ss13d = scalar2(b1(1,k),vtemp4d(1))
9538 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9546 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9547 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9549 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9550 & -0.5d0*ekont*(s2d+s12d)
9552 C Cartesian derivatives
9557 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9558 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9559 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9561 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9562 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9564 s2d = scalar2(b1(1,k),vtemp1d(1))
9566 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9567 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9568 s8d = -(atempd(1,1)+atempd(2,2))*
9569 & scalar2(cc(1,1,l),vtemp2(1))
9571 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9573 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9574 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9581 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9584 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9588 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9589 & - 0.5d0*(s8d+s12d)
9591 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9600 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9602 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9603 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9604 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9605 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9606 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9608 ss13d = scalar2(b1(1,k),vtemp4d(1))
9609 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9610 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9614 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9615 cd & 16*eel_turn6_num
9617 if (j.lt.nres-1) then
9624 if (l.lt.nres-1) then
9632 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9633 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9634 cgrad ghalf=0.5d0*ggg1(ll)
9636 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9637 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9638 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9639 & +ekont*derx_turn(ll,2,1)
9640 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9641 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9642 & +ekont*derx_turn(ll,4,1)
9643 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9644 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9645 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9646 cgrad ghalf=0.5d0*ggg2(ll)
9648 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9649 & +ekont*derx_turn(ll,2,2)
9650 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9651 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9652 & +ekont*derx_turn(ll,4,2)
9653 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9654 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9655 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9660 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9665 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9671 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9676 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9680 cd write (2,*) iii,g_corr6_loc(iii)
9683 eello_turn6=ekont*eel_turn6
9684 cd write (2,*) 'ekont',ekont
9685 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9689 crc-------------------------------------------------
9690 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9691 subroutine Eliptransfer(eliptran)
9692 implicit real*8 (a-h,o-z)
9693 include 'DIMENSIONS'
9694 include 'DIMENSIONS.ZSCOPT'
9695 include 'COMMON.GEO'
9696 include 'COMMON.VAR'
9697 include 'COMMON.LOCAL'
9698 include 'COMMON.CHAIN'
9699 include 'COMMON.DERIV'
9700 include 'COMMON.INTERACT'
9701 include 'COMMON.IOUNITS'
9702 include 'COMMON.CALC'
9703 include 'COMMON.CONTROL'
9704 include 'COMMON.SPLITELE'
9705 include 'COMMON.SBRIDGE'
9706 C this is done by Adasko
9710 C--bordliptop-- buffore starts
9711 C--bufliptop--- here true lipid starts
9713 C--buflipbot--- lipid ends buffore starts
9714 C--bordlipbot--buffore ends
9718 if (itype(i).eq.ntyp1) cycle
9720 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9721 if (positi.le.0) positi=positi+boxzsize
9723 C first for peptide groups
9724 c for each residue check if it is in lipid or lipid water border area
9725 if ((positi.gt.bordlipbot)
9726 &.and.(positi.lt.bordliptop)) then
9727 C the energy transfer exist
9728 if (positi.lt.buflipbot) then
9729 C what fraction I am in
9731 & ((positi-bordlipbot)/lipbufthick)
9732 C lipbufthick is thickenes of lipid buffore
9733 sslip=sscalelip(fracinbuf)
9734 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9735 eliptran=eliptran+sslip*pepliptran
9736 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9737 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9738 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9739 elseif (positi.gt.bufliptop) then
9740 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9741 sslip=sscalelip(fracinbuf)
9742 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9743 eliptran=eliptran+sslip*pepliptran
9744 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9745 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9746 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9747 C print *, "doing sscalefor top part"
9748 C print *,i,sslip,fracinbuf,ssgradlip
9750 eliptran=eliptran+pepliptran
9751 C print *,"I am in true lipid"
9754 C eliptran=elpitran+0.0 ! I am in water
9757 C print *, "nic nie bylo w lipidzie?"
9758 C now multiply all by the peptide group transfer factor
9759 C eliptran=eliptran*pepliptran
9760 C now the same for side chains
9763 if (itype(i).eq.ntyp1) cycle
9764 positi=(mod(c(3,i+nres),boxzsize))
9765 if (positi.le.0) positi=positi+boxzsize
9766 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9767 c for each residue check if it is in lipid or lipid water border area
9768 C respos=mod(c(3,i+nres),boxzsize)
9769 C print *,positi,bordlipbot,buflipbot
9770 if ((positi.gt.bordlipbot)
9771 & .and.(positi.lt.bordliptop)) then
9772 C the energy transfer exist
9773 if (positi.lt.buflipbot) then
9775 & ((positi-bordlipbot)/lipbufthick)
9776 C lipbufthick is thickenes of lipid buffore
9777 sslip=sscalelip(fracinbuf)
9778 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9779 eliptran=eliptran+sslip*liptranene(itype(i))
9780 gliptranx(3,i)=gliptranx(3,i)
9781 &+ssgradlip*liptranene(itype(i))
9782 gliptranc(3,i-1)= gliptranc(3,i-1)
9783 &+ssgradlip*liptranene(itype(i))
9784 C print *,"doing sccale for lower part"
9785 elseif (positi.gt.bufliptop) then
9787 &((bordliptop-positi)/lipbufthick)
9788 sslip=sscalelip(fracinbuf)
9789 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9790 eliptran=eliptran+sslip*liptranene(itype(i))
9791 gliptranx(3,i)=gliptranx(3,i)
9792 &+ssgradlip*liptranene(itype(i))
9793 gliptranc(3,i-1)= gliptranc(3,i-1)
9794 &+ssgradlip*liptranene(itype(i))
9795 C print *, "doing sscalefor top part",sslip,fracinbuf
9797 eliptran=eliptran+liptranene(itype(i))
9798 C print *,"I am in true lipid"
9800 endif ! if in lipid or buffor
9802 C eliptran=elpitran+0.0 ! I am in water
9808 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9810 SUBROUTINE MATVEC2(A1,V1,V2)
9811 implicit real*8 (a-h,o-z)
9812 include 'DIMENSIONS'
9813 DIMENSION A1(2,2),V1(2),V2(2)
9817 c 3 VI=VI+A1(I,K)*V1(K)
9821 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9822 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9827 C---------------------------------------
9828 SUBROUTINE MATMAT2(A1,A2,A3)
9829 implicit real*8 (a-h,o-z)
9830 include 'DIMENSIONS'
9831 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9832 c DIMENSION AI3(2,2)
9836 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9842 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9843 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9844 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9845 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9853 c-------------------------------------------------------------------------
9854 double precision function scalar2(u,v)
9856 double precision u(2),v(2)
9859 scalar2=u(1)*v(1)+u(2)*v(2)
9863 C-----------------------------------------------------------------------------
9865 subroutine transpose2(a,at)
9867 double precision a(2,2),at(2,2)
9874 c--------------------------------------------------------------------------
9875 subroutine transpose(n,a,at)
9878 double precision a(n,n),at(n,n)
9886 C---------------------------------------------------------------------------
9887 subroutine prodmat3(a1,a2,kk,transp,prod)
9890 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9892 crc double precision auxmat(2,2),prod_(2,2)
9895 crc call transpose2(kk(1,1),auxmat(1,1))
9896 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9897 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9899 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9900 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9901 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9902 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9903 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9904 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9905 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9906 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9909 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9910 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9912 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9913 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9914 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9915 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9916 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9917 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9918 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9919 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9922 c call transpose2(a2(1,1),a2t(1,1))
9925 crc print *,((prod_(i,j),i=1,2),j=1,2)
9926 crc print *,((prod(i,j),i=1,2),j=1,2)
9930 C-----------------------------------------------------------------------------
9931 double precision function scalar(u,v)
9933 double precision u(3),v(3)
9943 C-----------------------------------------------------------------------
9944 double precision function sscale(r)
9945 double precision r,gamm
9946 include "COMMON.SPLITELE"
9947 if(r.lt.r_cut-rlamb) then
9949 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9950 gamm=(r-(r_cut-rlamb))/rlamb
9951 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9957 C-----------------------------------------------------------------------
9958 C-----------------------------------------------------------------------
9959 double precision function sscagrad(r)
9960 double precision r,gamm
9961 include "COMMON.SPLITELE"
9962 if(r.lt.r_cut-rlamb) then
9964 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9965 gamm=(r-(r_cut-rlamb))/rlamb
9966 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9972 C-----------------------------------------------------------------------
9973 C-----------------------------------------------------------------------
9974 double precision function sscalelip(r)
9975 double precision r,gamm
9976 include "COMMON.SPLITELE"
9977 C if(r.lt.r_cut-rlamb) then
9979 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9980 C gamm=(r-(r_cut-rlamb))/rlamb
9981 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9987 C-----------------------------------------------------------------------
9988 double precision function sscagradlip(r)
9989 double precision r,gamm
9990 include "COMMON.SPLITELE"
9991 C if(r.lt.r_cut-rlamb) then
9993 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9994 C gamm=(r-(r_cut-rlamb))/rlamb
9995 sscagradlip=r*(6*r-6.0d0)
10002 C-----------------------------------------------------------------------
10003 subroutine set_shield_fac
10004 implicit real*8 (a-h,o-z)
10005 include 'DIMENSIONS'
10006 include 'DIMENSIONS.ZSCOPT'
10007 include 'COMMON.CHAIN'
10008 include 'COMMON.DERIV'
10009 include 'COMMON.IOUNITS'
10010 include 'COMMON.SHIELD'
10011 include 'COMMON.INTERACT'
10012 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10013 double precision div77_81/0.974996043d0/,
10014 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10016 C the vector between center of side_chain and peptide group
10017 double precision pep_side(3),long,side_calf(3),
10018 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10019 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10020 C the line belowe needs to be changed for FGPROC>1
10022 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10024 Cif there two consequtive dummy atoms there is no peptide group between them
10025 C the line below has to be changed for FGPROC>1
10028 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10032 C first lets set vector conecting the ithe side-chain with kth side-chain
10033 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10034 C pep_side(j)=2.0d0
10035 C and vector conecting the side-chain with its proper calfa
10036 side_calf(j)=c(j,k+nres)-c(j,k)
10037 C side_calf(j)=2.0d0
10038 pept_group(j)=c(j,i)-c(j,i+1)
10039 C lets have their lenght
10040 dist_pep_side=pep_side(j)**2+dist_pep_side
10041 dist_side_calf=dist_side_calf+side_calf(j)**2
10042 dist_pept_group=dist_pept_group+pept_group(j)**2
10044 dist_pep_side=dsqrt(dist_pep_side)
10045 dist_pept_group=dsqrt(dist_pept_group)
10046 dist_side_calf=dsqrt(dist_side_calf)
10048 pep_side_norm(j)=pep_side(j)/dist_pep_side
10049 side_calf_norm(j)=dist_side_calf
10051 C now sscale fraction
10052 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10053 C print *,buff_shield,"buff"
10055 if (sh_frac_dist.le.0.0) cycle
10056 C If we reach here it means that this side chain reaches the shielding sphere
10057 C Lets add him to the list for gradient
10058 ishield_list(i)=ishield_list(i)+1
10059 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10060 C this list is essential otherwise problem would be O3
10061 shield_list(ishield_list(i),i)=k
10062 C Lets have the sscale value
10063 if (sh_frac_dist.gt.1.0) then
10064 scale_fac_dist=1.0d0
10066 sh_frac_dist_grad(j)=0.0d0
10069 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10070 & *(2.0*sh_frac_dist-3.0d0)
10071 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
10072 & /dist_pep_side/buff_shield*0.5
10073 C remember for the final gradient multiply sh_frac_dist_grad(j)
10074 C for side_chain by factor -2 !
10076 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10077 C print *,"jestem",scale_fac_dist,fac_help_scale,
10078 C & sh_frac_dist_grad(j)
10081 C if ((i.eq.3).and.(k.eq.2)) then
10082 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
10086 C this is what is now we have the distance scaling now volume...
10087 short=short_r_sidechain(itype(k))
10088 long=long_r_sidechain(itype(k))
10089 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
10092 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
10093 C costhet_fac=0.0d0
10095 costhet_grad(j)=costhet_fac*pep_side(j)
10097 C remember for the final gradient multiply costhet_grad(j)
10098 C for side_chain by factor -2 !
10099 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10100 C pep_side0pept_group is vector multiplication
10101 pep_side0pept_group=0.0
10103 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10105 cosalfa=(pep_side0pept_group/
10106 & (dist_pep_side*dist_side_calf))
10107 fac_alfa_sin=1.0-cosalfa**2
10108 fac_alfa_sin=dsqrt(fac_alfa_sin)
10109 rkprim=fac_alfa_sin*(long-short)+short
10111 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
10112 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
10115 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10116 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10117 &*(long-short)/fac_alfa_sin*cosalfa/
10118 &((dist_pep_side*dist_side_calf))*
10119 &((side_calf(j))-cosalfa*
10120 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10122 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10123 &*(long-short)/fac_alfa_sin*cosalfa
10124 &/((dist_pep_side*dist_side_calf))*
10126 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10129 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10132 C now the gradient...
10133 C grad_shield is gradient of Calfa for peptide groups
10134 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
10136 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
10137 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
10139 grad_shield(j,i)=grad_shield(j,i)
10140 C gradient po skalowaniu
10141 & +(sh_frac_dist_grad(j)
10142 C gradient po costhet
10143 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10144 &-scale_fac_dist*(cosphi_grad_long(j))
10145 &/(1.0-cosphi) )*div77_81
10147 C grad_shield_side is Cbeta sidechain gradient
10148 grad_shield_side(j,ishield_list(i),i)=
10149 & (sh_frac_dist_grad(j)*(-2.0d0)
10150 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10151 & +scale_fac_dist*(cosphi_grad_long(j))
10152 & *2.0d0/(1.0-cosphi))
10153 & *div77_81*VofOverlap
10155 grad_shield_loc(j,ishield_list(i),i)=
10156 & scale_fac_dist*cosphi_grad_loc(j)
10157 & *2.0d0/(1.0-cosphi)
10158 & *div77_81*VofOverlap
10160 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10162 fac_shield(i)=VolumeTotal*div77_81+div4_81
10163 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10167 C--------------------------------------------------------------------------
10168 C first for shielding is setting of function of side-chains
10169 subroutine set_shield_fac2
10170 implicit real*8 (a-h,o-z)
10171 include 'DIMENSIONS'
10172 include 'DIMENSIONS.ZSCOPT'
10173 include 'COMMON.CHAIN'
10174 include 'COMMON.DERIV'
10175 include 'COMMON.IOUNITS'
10176 include 'COMMON.SHIELD'
10177 include 'COMMON.INTERACT'
10178 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10179 double precision div77_81/0.974996043d0/,
10180 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10182 C the vector between center of side_chain and peptide group
10183 double precision pep_side(3),long,side_calf(3),
10184 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10185 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10186 C the line belowe needs to be changed for FGPROC>1
10188 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10190 Cif there two consequtive dummy atoms there is no peptide group between them
10191 C the line below has to be changed for FGPROC>1
10194 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10198 C first lets set vector conecting the ithe side-chain with kth side-chain
10199 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10200 C pep_side(j)=2.0d0
10201 C and vector conecting the side-chain with its proper calfa
10202 side_calf(j)=c(j,k+nres)-c(j,k)
10203 C side_calf(j)=2.0d0
10204 pept_group(j)=c(j,i)-c(j,i+1)
10205 C lets have their lenght
10206 dist_pep_side=pep_side(j)**2+dist_pep_side
10207 dist_side_calf=dist_side_calf+side_calf(j)**2
10208 dist_pept_group=dist_pept_group+pept_group(j)**2
10210 dist_pep_side=dsqrt(dist_pep_side)
10211 dist_pept_group=dsqrt(dist_pept_group)
10212 dist_side_calf=dsqrt(dist_side_calf)
10214 pep_side_norm(j)=pep_side(j)/dist_pep_side
10215 side_calf_norm(j)=dist_side_calf
10217 C now sscale fraction
10218 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10219 C print *,buff_shield,"buff"
10221 if (sh_frac_dist.le.0.0) cycle
10222 C If we reach here it means that this side chain reaches the shielding sphere
10223 C Lets add him to the list for gradient
10224 ishield_list(i)=ishield_list(i)+1
10225 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10226 C this list is essential otherwise problem would be O3
10227 shield_list(ishield_list(i),i)=k
10228 C Lets have the sscale value
10229 if (sh_frac_dist.gt.1.0) then
10230 scale_fac_dist=1.0d0
10232 sh_frac_dist_grad(j)=0.0d0
10235 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10236 & *(2.0d0*sh_frac_dist-3.0d0)
10237 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
10238 & /dist_pep_side/buff_shield*0.5d0
10239 C remember for the final gradient multiply sh_frac_dist_grad(j)
10240 C for side_chain by factor -2 !
10242 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10243 C sh_frac_dist_grad(j)=0.0d0
10244 C scale_fac_dist=1.0d0
10245 C print *,"jestem",scale_fac_dist,fac_help_scale,
10246 C & sh_frac_dist_grad(j)
10249 C this is what is now we have the distance scaling now volume...
10250 short=short_r_sidechain(itype(k))
10251 long=long_r_sidechain(itype(k))
10252 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
10253 sinthet=short/dist_pep_side*costhet
10257 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
10258 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
10259 C & -short/dist_pep_side**2/costhet)
10260 C costhet_fac=0.0d0
10262 costhet_grad(j)=costhet_fac*pep_side(j)
10264 C remember for the final gradient multiply costhet_grad(j)
10265 C for side_chain by factor -2 !
10266 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10267 C pep_side0pept_group is vector multiplication
10268 pep_side0pept_group=0.0d0
10270 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10272 cosalfa=(pep_side0pept_group/
10273 & (dist_pep_side*dist_side_calf))
10274 fac_alfa_sin=1.0d0-cosalfa**2
10275 fac_alfa_sin=dsqrt(fac_alfa_sin)
10276 rkprim=fac_alfa_sin*(long-short)+short
10280 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
10282 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
10283 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
10284 & dist_pep_side**2)
10287 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10288 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10289 &*(long-short)/fac_alfa_sin*cosalfa/
10290 &((dist_pep_side*dist_side_calf))*
10291 &((side_calf(j))-cosalfa*
10292 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10293 C cosphi_grad_long(j)=0.0d0
10294 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10295 &*(long-short)/fac_alfa_sin*cosalfa
10296 &/((dist_pep_side*dist_side_calf))*
10298 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10299 C cosphi_grad_loc(j)=0.0d0
10301 C print *,sinphi,sinthet
10302 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
10305 C now the gradient...
10307 grad_shield(j,i)=grad_shield(j,i)
10308 C gradient po skalowaniu
10309 & +(sh_frac_dist_grad(j)*VofOverlap
10310 C gradient po costhet
10311 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
10312 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10313 & sinphi/sinthet*costhet*costhet_grad(j)
10314 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10316 C grad_shield_side is Cbeta sidechain gradient
10317 grad_shield_side(j,ishield_list(i),i)=
10318 & (sh_frac_dist_grad(j)*(-2.0d0)
10320 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10321 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10322 & sinphi/sinthet*costhet*costhet_grad(j)
10323 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10326 grad_shield_loc(j,ishield_list(i),i)=
10327 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10328 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
10329 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
10333 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10335 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
10336 c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i),
10337 c & " wshield",wshield
10338 c write(2,*) "TU",rpp(1,1),short,long,buff_shield
10342 C--------------------------------------------------------------------------
10343 double precision function tschebyshev(m,n,x,y)
10345 include "DIMENSIONS"
10347 double precision x(n),y,yy(0:maxvar),aux
10348 c Tschebyshev polynomial. Note that the first term is omitted
10349 c m=0: the constant term is included
10350 c m=1: the constant term is not included
10354 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
10363 C--------------------------------------------------------------------------
10364 double precision function gradtschebyshev(m,n,x,y)
10366 include "DIMENSIONS"
10368 double precision x(n+1),y,yy(0:maxvar),aux
10369 c Tschebyshev polynomial. Note that the first term is omitted
10370 c m=0: the constant term is included
10371 c m=1: the constant term is not included
10375 yy(i)=2*y*yy(i-1)-yy(i-2)
10379 aux=aux+x(i+1)*yy(i)*(i+1)
10380 C print *, x(i+1),yy(i),i
10382 gradtschebyshev=aux
10385 c----------------------------------------------------------------------------
10386 double precision function sscale2(r,r_cut,r0,rlamb)
10388 double precision r,gamm,r_cut,r0,rlamb,rr
10390 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
10391 c write (2,*) "rr",rr
10392 if(rr.lt.r_cut-rlamb) then
10394 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10395 gamm=(rr-(r_cut-rlamb))/rlamb
10396 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10402 C-----------------------------------------------------------------------
10403 double precision function sscalgrad2(r,r_cut,r0,rlamb)
10405 double precision r,gamm,r_cut,r0,rlamb,rr
10407 if(rr.lt.r_cut-rlamb) then
10409 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10410 gamm=(rr-(r_cut-rlamb))/rlamb
10412 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
10414 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
10421 c----------------------------------------------------------------------------
10422 subroutine e_saxs(Esaxs_constr)
10424 include 'DIMENSIONS'
10425 include 'DIMENSIONS.ZSCOPT'
10426 include 'DIMENSIONS.FREE'
10429 include "COMMON.SETUP"
10432 include 'COMMON.SBRIDGE'
10433 include 'COMMON.CHAIN'
10434 include 'COMMON.GEO'
10435 include 'COMMON.LOCAL'
10436 include 'COMMON.INTERACT'
10437 include 'COMMON.VAR'
10438 include 'COMMON.IOUNITS'
10439 include 'COMMON.DERIV'
10440 include 'COMMON.CONTROL'
10441 include 'COMMON.NAMES'
10442 include 'COMMON.FFIELD'
10443 include 'COMMON.LANGEVIN'
10444 include 'COMMON.SAXS'
10446 double precision Esaxs_constr
10447 integer i,iint,j,k,l
10448 double precision PgradC(maxSAXS,3,maxres),
10449 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
10451 double precision PgradC_(maxSAXS,3,maxres),
10452 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
10454 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
10455 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
10456 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
10457 & auxX,auxX1,CACAgrad,Cnorm
10458 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
10459 double precision dist
10461 c SAXS restraint penalty function
10463 write(iout,*) "------- SAXS penalty function start -------"
10464 write (iout,*) "nsaxs",nsaxs
10465 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
10466 write (iout,*) "Psaxs"
10468 write (iout,'(i5,e15.5)') i, Psaxs(i)
10471 Esaxs_constr = 0.0d0
10476 PgradC(k,l,j)=0.0d0
10477 PgradX(k,l,j)=0.0d0
10481 do i=iatsc_s,iatsc_e
10482 if (itype(i).eq.ntyp1) cycle
10483 do iint=1,nint_gr(i)
10484 do j=istart(i,iint),iend(i,iint)
10485 if (itype(j).eq.ntyp1) cycle
10488 dijCASC=dist(i,j+nres)
10489 dijSCCA=dist(i+nres,j)
10490 dijSCSC=dist(i+nres,j+nres)
10491 sigma2CACA=2.0d0/(pstok**2)
10492 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
10493 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
10494 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
10497 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10498 if (itype(j).ne.10) then
10499 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
10503 if (itype(i).ne.10) then
10504 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
10508 if (itype(i).ne.10 .and. itype(j).ne.10) then
10509 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
10513 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
10515 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10517 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10518 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
10519 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
10520 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
10523 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10524 PgradC(k,l,i) = PgradC(k,l,i)-aux
10525 PgradC(k,l,j) = PgradC(k,l,j)+aux
10527 if (itype(j).ne.10) then
10528 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
10529 PgradC(k,l,i) = PgradC(k,l,i)-aux
10530 PgradC(k,l,j) = PgradC(k,l,j)+aux
10531 PgradX(k,l,j) = PgradX(k,l,j)+aux
10534 if (itype(i).ne.10) then
10535 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
10536 PgradX(k,l,i) = PgradX(k,l,i)-aux
10537 PgradC(k,l,i) = PgradC(k,l,i)-aux
10538 PgradC(k,l,j) = PgradC(k,l,j)+aux
10541 if (itype(i).ne.10 .and. itype(j).ne.10) then
10542 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
10543 PgradC(k,l,i) = PgradC(k,l,i)-aux
10544 PgradC(k,l,j) = PgradC(k,l,j)+aux
10545 PgradX(k,l,i) = PgradX(k,l,i)-aux
10546 PgradX(k,l,j) = PgradX(k,l,j)+aux
10552 sigma2CACA=scal_rad**2*0.25d0/
10553 & (restok(itype(j))**2+restok(itype(i))**2)
10555 IF (saxs_cutoff.eq.0) THEN
10558 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10559 Pcalc(k) = Pcalc(k)+expCACA
10560 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10562 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10563 PgradC(k,l,i) = PgradC(k,l,i)-aux
10564 PgradC(k,l,j) = PgradC(k,l,j)+aux
10568 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
10571 c write (2,*) "ijk",i,j,k
10572 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
10573 if (sss2.eq.0.0d0) cycle
10574 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
10575 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
10576 Pcalc(k) = Pcalc(k)+expCACA
10578 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10580 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
10581 & ssgrad2*expCACA/sss2
10584 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10585 PgradC(k,l,i) = PgradC(k,l,i)+aux
10586 PgradC(k,l,j) = PgradC(k,l,j)-aux
10595 if (nfgtasks.gt.1) then
10596 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
10597 & MPI_SUM,king,FG_COMM,IERR)
10598 if (fg_rank.eq.king) then
10600 Pcalc(k) = Pcalc_(k)
10603 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
10604 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10605 if (fg_rank.eq.king) then
10609 PgradC(k,l,i) = PgradC_(k,l,i)
10615 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
10616 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10617 if (fg_rank.eq.king) then
10621 PgradX(k,l,i) = PgradX_(k,l,i)
10630 if (fg_rank.eq.king) then
10634 Cnorm = Cnorm + Pcalc(k)
10636 Esaxs_constr = dlog(Cnorm)-wsaxs0
10638 if (Pcalc(k).gt.0.0d0)
10639 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
10641 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
10645 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
10655 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
10656 auxC1 = auxC1+PgradC(k,l,i)
10658 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
10659 auxX1 = auxX1+PgradX(k,l,i)
10662 gsaxsC(l,i) = auxC - auxC1/Cnorm
10664 gsaxsX(l,i) = auxX - auxX1/Cnorm
10666 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
10667 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
10675 c----------------------------------------------------------------------------
10676 subroutine e_saxsC(Esaxs_constr)
10678 include 'DIMENSIONS'
10679 include 'DIMENSIONS.ZSCOPT'
10680 include 'DIMENSIONS.FREE'
10683 include "COMMON.SETUP"
10686 include 'COMMON.SBRIDGE'
10687 include 'COMMON.CHAIN'
10688 include 'COMMON.GEO'
10689 include 'COMMON.LOCAL'
10690 include 'COMMON.INTERACT'
10691 include 'COMMON.VAR'
10692 include 'COMMON.IOUNITS'
10693 include 'COMMON.DERIV'
10694 include 'COMMON.CONTROL'
10695 include 'COMMON.NAMES'
10696 include 'COMMON.FFIELD'
10697 include 'COMMON.LANGEVIN'
10698 include 'COMMON.SAXS'
10700 double precision Esaxs_constr
10701 integer i,iint,j,k,l
10702 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
10704 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
10706 double precision dk,dijCASPH,dijSCSPH,
10707 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
10708 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10710 c SAXS restraint penalty function
10712 write(iout,*) "------- SAXS penalty function start -------"
10713 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10714 & " isaxs_end",isaxs_end
10715 write (iout,*) "nnt",nnt," ntc",nct
10717 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10718 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10721 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10724 Esaxs_constr = 0.0d0
10726 do j=isaxs_start,isaxs_end
10738 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10740 if (itype(i).ne.10) then
10742 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10745 sigma2CA=2.0d0/pstok**2
10746 sigma2SC=4.0d0/restok(itype(i))**2
10747 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10748 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10749 Pcalc = Pcalc+expCASPH+expSCSPH
10751 write(*,*) "processor i j Pcalc",
10752 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
10754 CASPHgrad = sigma2CA*expCASPH
10755 SCSPHgrad = sigma2SC*expSCSPH
10757 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10758 PgradX(l,i) = PgradX(l,i) + aux
10759 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10764 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
10765 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
10768 logPtot = logPtot - dlog(Pcalc)
10769 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
10770 c & " logPtot",logPtot
10773 if (nfgtasks.gt.1) then
10774 c write (iout,*) "logPtot before reduction",logPtot
10775 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10776 & MPI_SUM,king,FG_COMM,IERR)
10778 c write (iout,*) "logPtot after reduction",logPtot
10779 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10780 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10781 if (fg_rank.eq.king) then
10784 gsaxsC(l,i) = gsaxsC_(l,i)
10788 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10789 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10790 if (fg_rank.eq.king) then
10793 gsaxsX(l,i) = gsaxsX_(l,i)
10799 Esaxs_constr = logPtot