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'
24 double precision fact(6)
25 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
47 C write(iout,*) 'po elektostatyce'
49 C Calculate electrostatic (H-bonding) energy of the main chain.
53 if (shield_mode.eq.1) then
55 else if (shield_mode.eq.2) then
58 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
59 C write(iout,*) 'po eelec'
61 C Calculate excluded-volume interaction energy between peptide groups
64 call escp(evdw2,evdw2_14)
66 c Calculate the bond-stretching energy
70 C write (iout,*) "estr",estr
72 C Calculate the disulfide-bridge and other energy and the contributions
73 C from other distance constraints.
74 cd print *,'Calling EHPB'
76 cd print *,'EHPB exitted succesfully.'
78 C Calculate the virtual-bond-angle energy.
80 C print *,'Bend energy finished.'
82 if (tor_mode.eq.0) then
85 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
93 if (with_theta_constr) call etheta_constr(ethetacnstr)
94 c call ebend(ebe,ethetacnstr)
95 cd print *,'Bend energy finished.'
97 C Calculate the SC local energy.
100 C print *,'SCLOC energy finished.'
102 C Calculate the virtual-bond torsional energy.
104 if (wtor.gt.0.0d0) then
105 if (tor_mode.eq.0) then
106 call etor(etors,fact(1))
108 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
110 call etor_kcc(etors,fact(1))
116 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
117 c print *,"Processor",myrank," computed Utor"
119 C 6/23/01 Calculate double-torsional energy
121 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
122 call etor_d(etors_d,fact(2))
126 c print *,"Processor",myrank," computed Utord"
128 if (wsccor.gt.0.0d0) then
129 call eback_sc_corr(esccor)
134 if (wliptran.gt.0) then
135 call Eliptransfer(eliptran)
141 C 12/1/95 Multi-body terms
145 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
146 & .or. wturn6.gt.0.0d0) then
147 c write(iout,*)"calling multibody_eello"
148 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
149 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
150 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
157 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
158 c write (iout,*) "Calling multibody_hbond"
159 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
162 c write (iout,*) "nsaxs",nsaxs
163 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
164 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
165 call e_saxs(Esaxs_constr)
166 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
167 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
168 call e_saxsC(Esaxs_constr)
169 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
174 c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology
175 if (constr_homology.ge.1) then
176 call e_modeller(ehomology_constr)
178 ehomology_constr=0.0d0
181 c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr
183 C BARTEK for dfa test!
185 if (wdfa_dist.gt.0) call edfad(edfadis)
186 c write(iout,*)'edfad is finished!', wdfa_dist,edfadis
188 if (wdfa_tor.gt.0) call edfat(edfator)
189 c write(iout,*)'edfat is finished!', wdfa_tor,edfator
191 if (wdfa_nei.gt.0) call edfan(edfanei)
192 c write(iout,*)'edfan is finished!', wdfa_nei,edfanei
194 if (wdfa_beta.gt.0) call edfab(edfabet)
195 c write(iout,*)'edfab is finished!', wdfa_beta,edfabet
198 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
200 if (shield_mode.gt.0) then
201 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
203 & +fact(1)*wvdwpp*evdw1
204 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
205 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
206 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
207 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
208 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
209 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr+wsaxs*esaxs_constr
210 & +wliptran*eliptran*esaxs_constr
211 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
214 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
216 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
217 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
218 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
219 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
220 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
221 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
222 & +wliptran*eliptran+wsaxs*esaxs_constr
223 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
227 if (shield_mode.gt.0) then
228 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
229 & +welec*fact(1)*(ees+evdw1)
230 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
231 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
232 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
233 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
234 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
235 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
236 & +wliptran*eliptran+wsaxs*esaxs_constr
237 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
240 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
241 & +welec*fact(1)*(ees+evdw1)
242 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
243 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
244 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
245 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
246 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
247 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
248 & +wliptran*eliptran+wsaxs*esaxs_constr
249 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
256 energia(2)=evdw2-evdw2_14
273 energia(8)=eello_turn3
274 energia(9)=eello_turn4
283 energia(20)=edihcnstr
286 energia(24)=ethetacnstr
287 energia(26)=esaxs_constr
288 energia(27)=ehomology_constr
296 if (isnan(etot).ne.0) energia(0)=1.0d+99
298 if (isnan(etot)) energia(0)=1.0d+99
303 idumm=proc_proc(etot,i)
305 call proc_proc(etot,i)
307 if(i.eq.1)energia(0)=1.0d+99
313 call enerprint(energia,fact)
317 C Sum up the components of the Cartesian gradient.
322 if (shield_mode.eq.0) then
323 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
324 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
326 & wstrain*ghpbc(j,i)+
327 & wcorr*fact(3)*gradcorr(j,i)+
328 & wel_loc*fact(2)*gel_loc(j,i)+
329 & wturn3*fact(2)*gcorr3_turn(j,i)+
330 & wturn4*fact(3)*gcorr4_turn(j,i)+
331 & wcorr5*fact(4)*gradcorr5(j,i)+
332 & wcorr6*fact(5)*gradcorr6(j,i)+
333 & wturn6*fact(5)*gcorr6_turn(j,i)+
334 & wsccor*fact(2)*gsccorc(j,i)+
335 & wliptran*gliptranc(j,i)+
336 & wdfa_dist*gdfad(j,i)+
337 & wdfa_tor*gdfat(j,i)+
338 & wdfa_nei*gdfan(j,i)+
339 & wdfa_beta*gdfab(j,i)
340 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
342 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
343 & wsccor*fact(2)*gsccorx(j,i)
344 & +wliptran*gliptranx(j,i)
346 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
347 & +fact(1)*wscp*gvdwc_scp(j,i)+
348 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
350 & wstrain*ghpbc(j,i)+
351 & wcorr*fact(3)*gradcorr(j,i)+
352 & wel_loc*fact(2)*gel_loc(j,i)+
353 & wturn3*fact(2)*gcorr3_turn(j,i)+
354 & wturn4*fact(3)*gcorr4_turn(j,i)+
355 & wcorr5*fact(4)*gradcorr5(j,i)+
356 & wcorr6*fact(5)*gradcorr6(j,i)+
357 & wturn6*fact(5)*gcorr6_turn(j,i)+
358 & wsccor*fact(2)*gsccorc(j,i)
359 & +wliptran*gliptranc(j,i)
360 & +welec*gshieldc(j,i)
361 & +welec*gshieldc_loc(j,i)
362 & +wcorr*gshieldc_ec(j,i)
363 & +wcorr*gshieldc_loc_ec(j,i)
364 & +wturn3*gshieldc_t3(j,i)
365 & +wturn3*gshieldc_loc_t3(j,i)
366 & +wturn4*gshieldc_t4(j,i)
367 & +wturn4*gshieldc_loc_t4(j,i)
368 & +wel_loc*gshieldc_ll(j,i)
369 & +wel_loc*gshieldc_loc_ll(j,i)+
370 & wdfa_dist*gdfad(j,i)+
371 & wdfa_tor*gdfat(j,i)+
372 & wdfa_nei*gdfan(j,i)+
373 & wdfa_beta*gdfab(j,i)
374 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
375 & +fact(1)*wscp*gradx_scp(j,i)+
377 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
378 & wsccor*fact(2)*gsccorx(j,i)
379 & +wliptran*gliptranx(j,i)
380 & +welec*gshieldx(j,i)
381 & +wcorr*gshieldx_ec(j,i)
382 & +wturn3*gshieldx_t3(j,i)
383 & +wturn4*gshieldx_t4(j,i)
384 & +wel_loc*gshieldx_ll(j,i)
390 if (shield_mode.eq.0) then
391 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
392 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
394 & wcorr*fact(3)*gradcorr(j,i)+
395 & wel_loc*fact(2)*gel_loc(j,i)+
396 & wturn3*fact(2)*gcorr3_turn(j,i)+
397 & wturn4*fact(3)*gcorr4_turn(j,i)+
398 & wcorr5*fact(4)*gradcorr5(j,i)+
399 & wcorr6*fact(5)*gradcorr6(j,i)+
400 & wturn6*fact(5)*gcorr6_turn(j,i)+
401 & wsccor*fact(2)*gsccorc(j,i)
402 & +wliptran*gliptranc(j,i)+
403 & wdfa_dist*gdfad(j,i)+
404 & wdfa_tor*gdfat(j,i)+
405 & wdfa_nei*gdfan(j,i)+
406 & wdfa_beta*gdfab(j,i)
408 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
410 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
411 & wsccor*fact(1)*gsccorx(j,i)
412 & +wliptran*gliptranx(j,i)
414 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
415 & fact(1)*wscp*gvdwc_scp(j,i)+
416 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
418 & wcorr*fact(3)*gradcorr(j,i)+
419 & wel_loc*fact(2)*gel_loc(j,i)+
420 & wturn3*fact(2)*gcorr3_turn(j,i)+
421 & wturn4*fact(3)*gcorr4_turn(j,i)+
422 & wcorr5*fact(4)*gradcorr5(j,i)+
423 & wcorr6*fact(5)*gradcorr6(j,i)+
424 & wturn6*fact(5)*gcorr6_turn(j,i)+
425 & wsccor*fact(2)*gsccorc(j,i)
426 & +wliptran*gliptranc(j,i)
427 & +welec*gshieldc(j,i)
428 & +welec*gshieldc_loc(j,i)
429 & +wcorr*gshieldc_ec(j,i)
430 & +wcorr*gshieldc_loc_ec(j,i)
431 & +wturn3*gshieldc_t3(j,i)
432 & +wturn3*gshieldc_loc_t3(j,i)
433 & +wturn4*gshieldc_t4(j,i)
434 & +wturn4*gshieldc_loc_t4(j,i)
435 & +wel_loc*gshieldc_ll(j,i)
436 & +wel_loc*gshieldc_loc_ll(j,i)+
437 & wdfa_dist*gdfad(j,i)+
438 & wdfa_tor*gdfat(j,i)+
439 & wdfa_nei*gdfan(j,i)+
440 & wdfa_beta*gdfab(j,i)
441 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
442 & fact(1)*wscp*gradx_scp(j,i)+
444 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
445 & wsccor*fact(1)*gsccorx(j,i)
446 & +wliptran*gliptranx(j,i)
447 & +welec*gshieldx(j,i)
448 & +wcorr*gshieldx_ec(j,i)
449 & +wturn3*gshieldx_t3(j,i)
450 & +wturn4*gshieldx_t4(j,i)
451 & +wel_loc*gshieldx_ll(j,i)
460 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
461 & +wcorr5*fact(4)*g_corr5_loc(i)
462 & +wcorr6*fact(5)*g_corr6_loc(i)
463 & +wturn4*fact(3)*gel_loc_turn4(i)
464 & +wturn3*fact(2)*gel_loc_turn3(i)
465 & +wturn6*fact(5)*gel_loc_turn6(i)
466 & +wel_loc*fact(2)*gel_loc_loc(i)
467 c & +wsccor*fact(1)*gsccor_loc(i)
468 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
471 if (dyn_ss) call dyn_set_nss
474 C------------------------------------------------------------------------
475 subroutine enerprint(energia,fact)
476 implicit real*8 (a-h,o-z)
478 include 'DIMENSIONS.ZSCOPT'
479 include 'COMMON.IOUNITS'
480 include 'COMMON.FFIELD'
481 include 'COMMON.SBRIDGE'
482 include 'COMMON.CONTROL'
483 double precision energia(0:max_ene),fact(6)
485 evdw=energia(1)+fact(6)*energia(21)
487 evdw2=energia(2)+energia(17)
499 eello_turn3=energia(8)
500 eello_turn4=energia(9)
501 eello_turn6=energia(10)
508 edihcnstr=energia(20)
510 ethetacnstr=energia(24)
513 ehomology_constr=energia(27)
515 edfadis = energia(28)
516 edfator = energia(29)
517 edfanei = energia(30)
518 edfabet = energia(31)
520 write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
521 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
522 & etors_d,wtor_d*fact(2),ehpb,wstrain,
524 & ecorr,wcorr*fact(3),
525 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
528 & wel_loc*fact(2),eello_turn3,wturn3*fact(2),
529 & eello_turn4,wturn4*fact(3),
531 & eello_turn6,wturn6*fact(5),
533 & esccor,wsccor*fact(1),edihcnstr,
534 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
535 & etube,wtube,esaxs,wsaxs,ehomology_constr,
536 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
539 10 format (/'Virtual-chain energies:'//
540 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
541 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
542 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
543 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
544 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
545 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
546 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
547 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
548 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
549 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
550 & ' (SS bridges & dist. cnstr.)'/
552 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
553 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
554 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
556 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
557 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
558 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
560 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
562 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
563 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
564 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
565 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
566 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
567 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
568 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
569 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
570 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
571 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
572 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
573 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
574 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
575 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
576 & 'ETOT= ',1pE16.6,' (total)')
579 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),
580 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
581 & etors_d,wtor_d*fact(2),ehpb,wstrain,
583 & ecorr,wcorr*fact(3),
584 & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
586 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
587 & eello_turn4,wturn4*fact(3),
589 & eello_turn6,wturn6*fact(5),
591 & esccor,wsccor*fact(1),edihcnstr,
592 & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc,
593 & etube,wtube,esaxs,wsaxs,ehomology_constr,
594 & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
597 10 format (/'Virtual-chain energies:'//
598 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
599 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
600 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
601 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
602 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
603 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
604 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
605 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
606 & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6,
607 & ' (SS bridges & dist. restr.)'/
609 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
610 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
611 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
613 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
614 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
615 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
617 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
619 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
620 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
621 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
622 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
623 & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/
624 & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/
625 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
626 & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/
627 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/
628 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
629 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
630 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
631 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
632 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
633 & 'ETOT= ',1pE16.6,' (total)')
637 C-----------------------------------------------------------------------
638 subroutine elj(evdw,evdw_t)
640 C This subroutine calculates the interaction energy of nonbonded side chains
641 C assuming the LJ potential of interaction.
643 implicit real*8 (a-h,o-z)
645 include 'DIMENSIONS.ZSCOPT'
646 include "DIMENSIONS.COMPAR"
647 parameter (accur=1.0d-10)
650 include 'COMMON.LOCAL'
651 include 'COMMON.CHAIN'
652 include 'COMMON.DERIV'
653 include 'COMMON.INTERACT'
654 include 'COMMON.TORSION'
655 include 'COMMON.ENEPS'
656 include 'COMMON.SBRIDGE'
657 include 'COMMON.NAMES'
658 include 'COMMON.IOUNITS'
660 include 'COMMON.CONTACTS'
661 include 'COMMON.CONTMAT'
666 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
670 eneps_temp(j,i)=0.0d0
679 if (itypi.eq.ntyp1) cycle
680 itypi1=iabs(itype(i+1))
687 C Calculate SC interaction energy.
690 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
691 cd & 'iend=',iend(i,iint)
692 do j=istart(i,iint),iend(i,iint)
694 if (itypj.eq.ntyp1) cycle
698 C Change 12/1/95 to calculate four-body interactions
699 rij=xj*xj+yj*yj+zj*zj
703 if (sss1.eq.0.0d0) cycle
704 sssgrad1=sscagrad(sqrij)
705 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
706 eps0ij=eps(itypi,itypj)
711 ij=icant(itypi,itypj)
713 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
714 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
717 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
718 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
719 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
720 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
721 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
722 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
723 if (bb.gt.0.0d0) then
724 evdw=evdw+sss1*evdwij
726 evdw_t=evdw_t+sss1*evdwij
730 C Calculate the components of the gradient in DC and X
732 fac=-rrij*(e1+evdwij)*sss1
733 & +evdwij*sssgrad1/sqrij/expon
738 gvdwx(k,i)=gvdwx(k,i)-gg(k)
739 gvdwx(k,j)=gvdwx(k,j)+gg(k)
743 gvdwc(l,k)=gvdwc(l,k)+gg(l)
749 C 12/1/95, revised on 5/20/97
751 C Calculate the contact function. The ith column of the array JCONT will
752 C contain the numbers of atoms that make contacts with the atom I (of numbers
753 C greater than I). The arrays FACONT and GACONT will contain the values of
754 C the contact function and its derivative.
756 C Uncomment next line, if the correlation interactions include EVDW explicitly.
757 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
758 C Uncomment next line, if the correlation interactions are contact function only
759 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
761 sigij=sigma(itypi,itypj)
762 r0ij=rs0(itypi,itypj)
764 C Check whether the SC's are not too far to make a contact.
767 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
768 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
770 if (fcont.gt.0.0D0) then
771 C If the SC-SC distance if close to sigma, apply spline.
772 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
773 cAdam & fcont1,fprimcont1)
774 cAdam fcont1=1.0d0-fcont1
775 cAdam if (fcont1.gt.0.0d0) then
776 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
777 cAdam fcont=fcont*fcont1
779 C Uncomment following 4 lines to have the geometric average of the epsilon0's
780 cga eps0ij=1.0d0/dsqrt(eps0ij)
782 cga gg(k)=gg(k)*eps0ij
784 cga eps0ij=-evdwij*eps0ij
785 C Uncomment for AL's type of SC correlation interactions.
787 num_conti=num_conti+1
789 facont(num_conti,i)=fcont*eps0ij
790 fprimcont=eps0ij*fprimcont/rij
792 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
793 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
794 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
795 C Uncomment following 3 lines for Skolnick's type of SC correlation.
796 gacont(1,num_conti,i)=-fprimcont*xj
797 gacont(2,num_conti,i)=-fprimcont*yj
798 gacont(3,num_conti,i)=-fprimcont*zj
799 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
800 cd write (iout,'(2i3,3f10.5)')
801 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
809 num_cont(i)=num_conti
815 gvdwc(j,i)=expon*gvdwc(j,i)
816 gvdwx(j,i)=expon*gvdwx(j,i)
820 C******************************************************************************
824 C To save time, the factor of EXPON has been extracted from ALL components
825 C of GVDWC and GRADX. Remember to multiply them by this factor before further
828 C******************************************************************************
831 C-----------------------------------------------------------------------------
832 subroutine eljk(evdw,evdw_t)
834 C This subroutine calculates the interaction energy of nonbonded side chains
835 C assuming the LJK potential of interaction.
837 implicit real*8 (a-h,o-z)
839 include 'DIMENSIONS.ZSCOPT'
840 include "DIMENSIONS.COMPAR"
843 include 'COMMON.LOCAL'
844 include 'COMMON.CHAIN'
845 include 'COMMON.DERIV'
846 include 'COMMON.INTERACT'
847 include 'COMMON.ENEPS'
848 include 'COMMON.IOUNITS'
849 include 'COMMON.NAMES'
854 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
857 eneps_temp(j,i)=0.0d0
864 if (itypi.eq.ntyp1) cycle
865 itypi1=iabs(itype(i+1))
870 C Calculate SC interaction energy.
873 do j=istart(i,iint),iend(i,iint)
875 if (itypj.eq.ntyp1) cycle
879 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
881 e_augm=augm(itypi,itypj)*fac_augm
885 if (sss1.eq.0.0d0) cycle
886 sssgrad1=sscagrad(rij)
887 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
888 fac=r_shift_inv**expon
892 ij=icant(itypi,itypj)
893 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
894 & /dabs(eps(itypi,itypj))
895 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
896 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
897 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
898 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
899 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
900 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
901 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
902 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
903 if (bb.gt.0.0d0) then
904 evdw=evdw+evdwij*sss1
906 evdw_t=evdw_t+evdwij*sss1
910 C Calculate the components of the gradient in DC and X
912 fac=(-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2))*sss1
913 & +evdwij*sssgrad1*r_inv_ij/expon
918 gvdwx(k,i)=gvdwx(k,i)-gg(k)
919 gvdwx(k,j)=gvdwx(k,j)+gg(k)
923 gvdwc(l,k)=gvdwc(l,k)+gg(l)
933 gvdwc(j,i)=expon*gvdwc(j,i)
934 gvdwx(j,i)=expon*gvdwx(j,i)
940 C-----------------------------------------------------------------------------
941 subroutine ebp(evdw,evdw_t)
943 C This subroutine calculates the interaction energy of nonbonded side chains
944 C assuming the Berne-Pechukas potential of interaction.
946 implicit real*8 (a-h,o-z)
948 include 'DIMENSIONS.ZSCOPT'
949 include "DIMENSIONS.COMPAR"
952 include 'COMMON.LOCAL'
953 include 'COMMON.CHAIN'
954 include 'COMMON.DERIV'
955 include 'COMMON.NAMES'
956 include 'COMMON.INTERACT'
957 include 'COMMON.ENEPS'
958 include 'COMMON.IOUNITS'
959 include 'COMMON.CALC'
961 c double precision rrsave(maxdim)
967 eneps_temp(j,i)=0.0d0
972 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
973 c if (icall.eq.0) then
981 if (itypi.eq.ntyp1) cycle
982 itypi1=iabs(itype(i+1))
986 dxi=dc_norm(1,nres+i)
987 dyi=dc_norm(2,nres+i)
988 dzi=dc_norm(3,nres+i)
989 dsci_inv=vbld_inv(i+nres)
991 C Calculate SC interaction energy.
994 do j=istart(i,iint),iend(i,iint)
997 if (itypj.eq.ntyp1) cycle
998 dscj_inv=vbld_inv(j+nres)
999 chi1=chi(itypi,itypj)
1000 chi2=chi(itypj,itypi)
1007 alf12=0.5D0*(alf1+alf2)
1008 C For diagnostics only!!!
1021 dxj=dc_norm(1,nres+j)
1022 dyj=dc_norm(2,nres+j)
1023 dzj=dc_norm(3,nres+j)
1024 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1025 cd if (icall.eq.0) then
1031 sss1=sscale(1.0d0/rij)
1032 if (sss1.eq.0.0d0) cycle
1033 sssgrad1=sscagrad(1.0d0/rij)
1035 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1037 C Calculate whole angle-dependent part of epsilon and contributions
1038 C to its derivatives
1039 fac=(rrij*sigsq)**expon2
1042 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1043 eps2der=evdwij*eps3rt
1044 eps3der=evdwij*eps2rt
1045 evdwij=evdwij*eps2rt*eps3rt
1046 ij=icant(itypi,itypj)
1047 aux=eps1*eps2rt**2*eps3rt**2
1048 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
1049 & /dabs(eps(itypi,itypj))
1050 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
1051 if (bb.gt.0.0d0) then
1052 evdw=evdw+sss1*evdwij
1054 evdw_t=evdw_t+sss1*evdwij
1058 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1060 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1061 & restyp(itypi),i,restyp(itypj),j,
1062 & epsi,sigm,chi1,chi2,chip1,chip2,
1063 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1064 & om1,om2,om12,1.0D0/dsqrt(rrij),
1067 C Calculate gradient components.
1068 e1=e1*eps1*eps2rt**2*eps3rt**2
1069 fac=-expon*(e1+evdwij)
1072 & +evdwij*sssgrad1/sss1*rij
1073 C Calculate radial part of the gradient
1077 C Calculate the angular part of the gradient and sum add the contributions
1078 C to the appropriate components of the Cartesian gradient.
1087 C-----------------------------------------------------------------------------
1088 subroutine egb(evdw,evdw_t)
1090 C This subroutine calculates the interaction energy of nonbonded side chains
1091 C assuming the Gay-Berne potential of interaction.
1093 implicit real*8 (a-h,o-z)
1094 include 'DIMENSIONS'
1095 include 'DIMENSIONS.ZSCOPT'
1096 include "DIMENSIONS.COMPAR"
1097 include 'COMMON.CONTROL'
1098 include 'COMMON.GEO'
1099 include 'COMMON.VAR'
1100 include 'COMMON.LOCAL'
1101 include 'COMMON.CHAIN'
1102 include 'COMMON.DERIV'
1103 include 'COMMON.NAMES'
1104 include 'COMMON.INTERACT'
1105 include 'COMMON.ENEPS'
1106 include 'COMMON.IOUNITS'
1107 include 'COMMON.CALC'
1108 include 'COMMON.SBRIDGE'
1111 integer icant,xshift,yshift,zshift
1115 eneps_temp(j,i)=0.0d0
1118 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1122 c if (icall.gt.0) lprn=.true.
1124 do i=iatsc_s,iatsc_e
1125 itypi=iabs(itype(i))
1126 if (itypi.eq.ntyp1) cycle
1127 itypi1=iabs(itype(i+1))
1131 C returning the ith atom to box
1133 if (xi.lt.0) xi=xi+boxxsize
1135 if (yi.lt.0) yi=yi+boxysize
1137 if (zi.lt.0) zi=zi+boxzsize
1138 if ((zi.gt.bordlipbot)
1139 &.and.(zi.lt.bordliptop)) then
1140 C the energy transfer exist
1141 if (zi.lt.buflipbot) then
1142 C what fraction I am in
1144 & ((zi-bordlipbot)/lipbufthick)
1145 C lipbufthick is thickenes of lipid buffore
1146 sslipi=sscalelip(fracinbuf)
1147 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1148 elseif (zi.gt.bufliptop) then
1149 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1150 sslipi=sscalelip(fracinbuf)
1151 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1161 dxi=dc_norm(1,nres+i)
1162 dyi=dc_norm(2,nres+i)
1163 dzi=dc_norm(3,nres+i)
1164 dsci_inv=vbld_inv(i+nres)
1166 C Calculate SC interaction energy.
1168 do iint=1,nint_gr(i)
1169 do j=istart(i,iint),iend(i,iint)
1170 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1171 call dyn_ssbond_ene(i,j,evdwij)
1173 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1174 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1175 C triple bond artifac removal
1176 do k=j+1,iend(i,iint)
1177 C search over all next residues
1178 if (dyn_ss_mask(k)) then
1179 C check if they are cysteins
1180 C write(iout,*) 'k=',k
1181 call triple_ssbond_ene(i,j,k,evdwij)
1182 C call the energy function that removes the artifical triple disulfide
1183 C bond the soubroutine is located in ssMD.F
1185 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1186 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1187 endif!dyn_ss_mask(k)
1191 itypj=iabs(itype(j))
1192 if (itypj.eq.ntyp1) cycle
1193 dscj_inv=vbld_inv(j+nres)
1194 sig0ij=sigma(itypi,itypj)
1195 chi1=chi(itypi,itypj)
1196 chi2=chi(itypj,itypi)
1203 alf12=0.5D0*(alf1+alf2)
1204 C For diagnostics only!!!
1217 C returning jth atom to box
1219 if (xj.lt.0) xj=xj+boxxsize
1221 if (yj.lt.0) yj=yj+boxysize
1223 if (zj.lt.0) zj=zj+boxzsize
1224 if ((zj.gt.bordlipbot)
1225 &.and.(zj.lt.bordliptop)) then
1226 C the energy transfer exist
1227 if (zj.lt.buflipbot) then
1228 C what fraction I am in
1230 & ((zj-bordlipbot)/lipbufthick)
1231 C lipbufthick is thickenes of lipid buffore
1232 sslipj=sscalelip(fracinbuf)
1233 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1234 elseif (zj.gt.bufliptop) then
1235 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1236 sslipj=sscalelip(fracinbuf)
1237 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1246 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1247 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1248 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1249 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1250 C if (aa.ne.aa_aq(itypi,itypj)) then
1252 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1253 C & bb_aq(itypi,itypj)-bb,
1257 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1258 C checking the distance
1259 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1264 C finding the closest
1268 xj=xj_safe+xshift*boxxsize
1269 yj=yj_safe+yshift*boxysize
1270 zj=zj_safe+zshift*boxzsize
1271 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1272 if(dist_temp.lt.dist_init) then
1282 if (subchap.eq.1) then
1292 dxj=dc_norm(1,nres+j)
1293 dyj=dc_norm(2,nres+j)
1294 dzj=dc_norm(3,nres+j)
1295 c write (iout,*) i,j,xj,yj,zj
1296 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1298 sss=sscale(1.0d0/rij)
1299 sssgrad=sscagrad(1.0d0/rij)
1300 if (sss.le.0.0) cycle
1301 C Calculate angle-dependent terms of energy and contributions to their
1306 sig=sig0ij*dsqrt(sigsq)
1307 rij_shift=1.0D0/rij-sig+sig0ij
1308 C I hate to put IF's in the loops, but here don't have another choice!!!!
1309 if (rij_shift.le.0.0D0) then
1314 c---------------------------------------------------------------
1315 rij_shift=1.0D0/rij_shift
1316 fac=rij_shift**expon
1319 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1320 eps2der=evdwij*eps3rt
1321 eps3der=evdwij*eps2rt
1322 evdwij=evdwij*eps2rt*eps3rt
1324 evdw=evdw+evdwij*sss
1326 evdw_t=evdw_t+evdwij*sss
1328 ij=icant(itypi,itypj)
1329 aux=eps1*eps2rt**2*eps3rt**2
1330 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1331 & /dabs(eps(itypi,itypj))
1332 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1333 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1334 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1335 c & aux*e2/eps(itypi,itypj)
1337 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1341 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1342 & restyp(itypi),i,restyp(itypj),j,
1343 & epsi,sigm,chi1,chi2,chip1,chip2,
1344 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1345 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1347 write (iout,*) "partial sum", evdw, evdw_t
1351 if (energy_dec) write (iout,'(a,2i5,3f10.5)')
1352 & 'r sss evdw',i,j,1.0d0/rij,sss,evdwij
1354 C Calculate gradient components.
1355 e1=e1*eps1*eps2rt**2*eps3rt**2
1356 fac=-expon*(e1+evdwij)*rij_shift
1359 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1360 C Calculate the radial part of the gradient
1364 C Calculate angular part of the gradient.
1367 C write(iout,*) "partial sum", evdw, evdw_t
1374 C-----------------------------------------------------------------------------
1375 subroutine egbv(evdw,evdw_t)
1377 C This subroutine calculates the interaction energy of nonbonded side chains
1378 C assuming the Gay-Berne-Vorobjev potential of interaction.
1380 implicit real*8 (a-h,o-z)
1381 include 'DIMENSIONS'
1382 include 'DIMENSIONS.ZSCOPT'
1383 include "DIMENSIONS.COMPAR"
1384 include 'COMMON.GEO'
1385 include 'COMMON.VAR'
1386 include 'COMMON.LOCAL'
1387 include 'COMMON.CHAIN'
1388 include 'COMMON.DERIV'
1389 include 'COMMON.NAMES'
1390 include 'COMMON.INTERACT'
1391 include 'COMMON.ENEPS'
1392 include 'COMMON.IOUNITS'
1393 include 'COMMON.CALC'
1394 common /srutu/ icall
1400 eneps_temp(j,i)=0.0d0
1405 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1408 c if (icall.gt.0) lprn=.true.
1410 do i=iatsc_s,iatsc_e
1411 itypi=iabs(itype(i))
1412 if (itypi.eq.ntyp1) cycle
1413 itypi1=iabs(itype(i+1))
1417 dxi=dc_norm(1,nres+i)
1418 dyi=dc_norm(2,nres+i)
1419 dzi=dc_norm(3,nres+i)
1420 dsci_inv=vbld_inv(i+nres)
1422 C Calculate SC interaction energy.
1424 do iint=1,nint_gr(i)
1425 do j=istart(i,iint),iend(i,iint)
1427 itypj=iabs(itype(j))
1428 if (itypj.eq.ntyp1) cycle
1429 dscj_inv=vbld_inv(j+nres)
1430 sig0ij=sigma(itypi,itypj)
1431 r0ij=r0(itypi,itypj)
1432 chi1=chi(itypi,itypj)
1433 chi2=chi(itypj,itypi)
1440 alf12=0.5D0*(alf1+alf2)
1441 C For diagnostics only!!!
1454 dxj=dc_norm(1,nres+j)
1455 dyj=dc_norm(2,nres+j)
1456 dzj=dc_norm(3,nres+j)
1457 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1459 sss=sscale(1.0d0/rij)
1460 if (sss.eq.0.0d0) cycle
1461 sssgrad=sscagrad(1.0d0/rij)
1462 C Calculate angle-dependent terms of energy and contributions to their
1466 sig=sig0ij*dsqrt(sigsq)
1467 rij_shift=1.0D0/rij-sig+r0ij
1468 C I hate to put IF's in the loops, but here don't have another choice!!!!
1469 if (rij_shift.le.0.0D0) then
1474 c---------------------------------------------------------------
1475 rij_shift=1.0D0/rij_shift
1476 fac=rij_shift**expon
1479 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1480 eps2der=evdwij*eps3rt
1481 eps3der=evdwij*eps2rt
1482 fac_augm=rrij**expon
1483 e_augm=augm(itypi,itypj)*fac_augm
1484 evdwij=evdwij*eps2rt*eps3rt
1485 if (bb.gt.0.0d0) then
1486 evdw=evdw+(evdwij+e_augm)*sss
1488 evdw_t=evdw_t+(evdwij+e_augm)*sss
1490 ij=icant(itypi,itypj)
1491 aux=eps1*eps2rt**2*eps3rt**2
1492 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1493 & /dabs(eps(itypi,itypj))
1494 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1495 c eneps_temp(ij)=eneps_temp(ij)
1496 c & +(evdwij+e_augm)/eps(itypi,itypj)
1498 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1499 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1500 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1501 c & restyp(itypi),i,restyp(itypj),j,
1502 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1503 c & chi1,chi2,chip1,chip2,
1504 c & eps1,eps2rt**2,eps3rt**2,
1505 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1509 C Calculate gradient components.
1510 e1=e1*eps1*eps2rt**2*eps3rt**2
1511 fac=-expon*(e1+evdwij)*rij_shift
1513 fac=rij*fac-2*expon*rrij*e_augm
1514 fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
1515 C Calculate the radial part of the gradient
1519 C Calculate angular part of the gradient.
1527 C-----------------------------------------------------------------------------
1528 subroutine sc_angular
1529 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1530 C om12. Called by ebp, egb, and egbv.
1532 include 'COMMON.CALC'
1536 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1537 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1538 om12=dxi*dxj+dyi*dyj+dzi*dzj
1540 C Calculate eps1(om12) and its derivative in om12
1541 faceps1=1.0D0-om12*chiom12
1542 faceps1_inv=1.0D0/faceps1
1543 eps1=dsqrt(faceps1_inv)
1544 C Following variable is eps1*deps1/dom12
1545 eps1_om12=faceps1_inv*chiom12
1546 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1551 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1552 sigsq=1.0D0-facsig*faceps1_inv
1553 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1554 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1555 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1556 C Calculate eps2 and its derivatives in om1, om2, and om12.
1559 chipom12=chip12*om12
1560 facp=1.0D0-om12*chipom12
1562 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1563 C Following variable is the square root of eps2
1564 eps2rt=1.0D0-facp1*facp_inv
1565 C Following three variables are the derivatives of the square root of eps
1566 C in om1, om2, and om12.
1567 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1568 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1569 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1570 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1571 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1572 C Calculate whole angle-dependent part of epsilon and contributions
1573 C to its derivatives
1576 C----------------------------------------------------------------------------
1578 implicit real*8 (a-h,o-z)
1579 include 'DIMENSIONS'
1580 include 'DIMENSIONS.ZSCOPT'
1581 include 'COMMON.CHAIN'
1582 include 'COMMON.DERIV'
1583 include 'COMMON.CALC'
1584 double precision dcosom1(3),dcosom2(3)
1585 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1586 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1587 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1588 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1590 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1591 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1594 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1597 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1598 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1599 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1600 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1601 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1602 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1605 C Calculate the components of the gradient in DC and X
1609 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1614 c------------------------------------------------------------------------------
1615 subroutine vec_and_deriv
1616 implicit real*8 (a-h,o-z)
1617 include 'DIMENSIONS'
1618 include 'DIMENSIONS.ZSCOPT'
1619 include 'COMMON.IOUNITS'
1620 include 'COMMON.GEO'
1621 include 'COMMON.VAR'
1622 include 'COMMON.LOCAL'
1623 include 'COMMON.CHAIN'
1624 include 'COMMON.VECTORS'
1625 include 'COMMON.DERIV'
1626 include 'COMMON.INTERACT'
1627 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1628 C Compute the local reference systems. For reference system (i), the
1629 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1630 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1632 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1633 if (i.eq.nres-1) then
1634 C Case of the last full residue
1635 C Compute the Z-axis
1636 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1637 costh=dcos(pi-theta(nres))
1638 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1639 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1645 C Compute the derivatives of uz
1647 uzder(2,1,1)=-dc_norm(3,i-1)
1648 uzder(3,1,1)= dc_norm(2,i-1)
1649 uzder(1,2,1)= dc_norm(3,i-1)
1651 uzder(3,2,1)=-dc_norm(1,i-1)
1652 uzder(1,3,1)=-dc_norm(2,i-1)
1653 uzder(2,3,1)= dc_norm(1,i-1)
1656 uzder(2,1,2)= dc_norm(3,i)
1657 uzder(3,1,2)=-dc_norm(2,i)
1658 uzder(1,2,2)=-dc_norm(3,i)
1660 uzder(3,2,2)= dc_norm(1,i)
1661 uzder(1,3,2)= dc_norm(2,i)
1662 uzder(2,3,2)=-dc_norm(1,i)
1665 C Compute the Y-axis
1668 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1671 C Compute the derivatives of uy
1674 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1675 & -dc_norm(k,i)*dc_norm(j,i-1)
1676 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1678 uyder(j,j,1)=uyder(j,j,1)-costh
1679 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1684 uygrad(l,k,j,i)=uyder(l,k,j)
1685 uzgrad(l,k,j,i)=uzder(l,k,j)
1689 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1690 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1691 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1692 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1696 C Compute the Z-axis
1697 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1698 costh=dcos(pi-theta(i+2))
1699 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1704 C Compute the derivatives of uz
1706 uzder(2,1,1)=-dc_norm(3,i+1)
1707 uzder(3,1,1)= dc_norm(2,i+1)
1708 uzder(1,2,1)= dc_norm(3,i+1)
1710 uzder(3,2,1)=-dc_norm(1,i+1)
1711 uzder(1,3,1)=-dc_norm(2,i+1)
1712 uzder(2,3,1)= dc_norm(1,i+1)
1715 uzder(2,1,2)= dc_norm(3,i)
1716 uzder(3,1,2)=-dc_norm(2,i)
1717 uzder(1,2,2)=-dc_norm(3,i)
1719 uzder(3,2,2)= dc_norm(1,i)
1720 uzder(1,3,2)= dc_norm(2,i)
1721 uzder(2,3,2)=-dc_norm(1,i)
1724 C Compute the Y-axis
1727 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1730 C Compute the derivatives of uy
1733 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1734 & -dc_norm(k,i)*dc_norm(j,i+1)
1735 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1737 uyder(j,j,1)=uyder(j,j,1)-costh
1738 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1743 uygrad(l,k,j,i)=uyder(l,k,j)
1744 uzgrad(l,k,j,i)=uzder(l,k,j)
1748 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1749 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1750 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1751 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1757 vbld_inv_temp(1)=vbld_inv(i+1)
1758 if (i.lt.nres-1) then
1759 vbld_inv_temp(2)=vbld_inv(i+2)
1761 vbld_inv_temp(2)=vbld_inv(i)
1766 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1767 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1775 C--------------------------------------------------------------------------
1776 subroutine set_matrices
1777 implicit real*8 (a-h,o-z)
1778 include 'DIMENSIONS'
1782 integer status(MPI_STATUS_SIZE)
1784 include 'DIMENSIONS.ZSCOPT'
1785 include 'COMMON.IOUNITS'
1786 include 'COMMON.GEO'
1787 include 'COMMON.VAR'
1788 include 'COMMON.LOCAL'
1789 include 'COMMON.CHAIN'
1790 include 'COMMON.DERIV'
1791 include 'COMMON.INTERACT'
1792 include 'COMMON.CORRMAT'
1793 include 'COMMON.TORSION'
1794 include 'COMMON.VECTORS'
1795 include 'COMMON.FFIELD'
1796 double precision auxvec(2),auxmat(2,2)
1798 C Compute the virtual-bond-torsional-angle dependent quantities needed
1799 C to calculate the el-loc multibody terms of various order.
1801 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1805 innt=chain_border(1,ii)
1806 inct=chain_border(2,ii)
1807 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1808 if (i.gt. innt+2 .and. i.lt.inct+2) then
1809 iti = itype2loc(itype(i-2))
1813 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1814 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1815 if (i.gt. innt+1 .and. i.lt.inct+1) then
1816 iti1 = itype2loc(itype(i-1))
1821 cost1=dcos(theta(i-1))
1822 sint1=dsin(theta(i-1))
1824 sint1cub=sint1sq*sint1
1825 sint1cost1=2*sint1*cost1
1827 write (iout,*) "bnew1",i,iti
1828 write (iout,*) (bnew1(k,1,iti),k=1,3)
1829 write (iout,*) (bnew1(k,2,iti),k=1,3)
1830 write (iout,*) "bnew2",i,iti
1831 write (iout,*) (bnew2(k,1,iti),k=1,3)
1832 write (iout,*) (bnew2(k,2,iti),k=1,3)
1835 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1837 gtb1(k,i-2)=cost1*b1k-sint1sq*
1838 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1839 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1841 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1842 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1845 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1846 cc(1,k,i-2)=sint1sq*aux
1847 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1848 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1849 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1850 dd(1,k,i-2)=sint1sq*aux
1851 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1852 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1854 cc(2,1,i-2)=cc(1,2,i-2)
1855 cc(2,2,i-2)=-cc(1,1,i-2)
1856 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1857 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1858 dd(2,1,i-2)=dd(1,2,i-2)
1859 dd(2,2,i-2)=-dd(1,1,i-2)
1860 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1861 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1864 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1865 EE(l,k,i-2)=sint1sq*aux
1867 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1870 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1871 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1872 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1873 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1875 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1876 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1877 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1879 c b1tilde(1,i-2)=b1(1,i-2)
1880 c b1tilde(2,i-2)=-b1(2,i-2)
1881 c b2tilde(1,i-2)=b2(1,i-2)
1882 c b2tilde(2,i-2)=-b2(2,i-2)
1884 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1885 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1886 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1887 write (iout,*) 'theta=', theta(i-1)
1890 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1891 c iti = itype2loc(itype(i-2))
1895 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1896 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1897 c iti1 = itype2loc(itype(i-1))
1907 CC(k,l,i-2)=ccold(k,l,iti)
1908 DD(k,l,i-2)=ddold(k,l,iti)
1909 EE(k,l,i-2)=eeold(k,l,iti)
1913 b1tilde(1,i-2)= b1(1,i-2)
1914 b1tilde(2,i-2)=-b1(2,i-2)
1915 b2tilde(1,i-2)= b2(1,i-2)
1916 b2tilde(2,i-2)=-b2(2,i-2)
1918 Ctilde(1,1,i-2)= CC(1,1,i-2)
1919 Ctilde(1,2,i-2)= CC(1,2,i-2)
1920 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1921 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1923 Dtilde(1,1,i-2)= DD(1,1,i-2)
1924 Dtilde(1,2,i-2)= DD(1,2,i-2)
1925 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1926 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1928 write(iout,*) "i",i," iti",iti
1929 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1930 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1934 if (i .lt. nres+1) then
1971 if (i .gt. 3 .and. i .lt. nres+1) then
1972 obrot_der(1,i-2)=-sin1
1973 obrot_der(2,i-2)= cos1
1974 Ugder(1,1,i-2)= sin1
1975 Ugder(1,2,i-2)=-cos1
1976 Ugder(2,1,i-2)=-cos1
1977 Ugder(2,2,i-2)=-sin1
1980 obrot2_der(1,i-2)=-dwasin2
1981 obrot2_der(2,i-2)= dwacos2
1982 Ug2der(1,1,i-2)= dwasin2
1983 Ug2der(1,2,i-2)=-dwacos2
1984 Ug2der(2,1,i-2)=-dwacos2
1985 Ug2der(2,2,i-2)=-dwasin2
1987 obrot_der(1,i-2)=0.0d0
1988 obrot_der(2,i-2)=0.0d0
1989 Ugder(1,1,i-2)=0.0d0
1990 Ugder(1,2,i-2)=0.0d0
1991 Ugder(2,1,i-2)=0.0d0
1992 Ugder(2,2,i-2)=0.0d0
1993 obrot2_der(1,i-2)=0.0d0
1994 obrot2_der(2,i-2)=0.0d0
1995 Ug2der(1,1,i-2)=0.0d0
1996 Ug2der(1,2,i-2)=0.0d0
1997 Ug2der(2,1,i-2)=0.0d0
1998 Ug2der(2,2,i-2)=0.0d0
2000 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2001 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2002 iti = itype2loc(itype(i-2))
2006 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2007 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2008 iti1 = itype2loc(itype(i-1))
2012 cd write (iout,*) '*******i',i,' iti1',iti
2013 cd write (iout,*) 'b1',b1(:,iti)
2014 cd write (iout,*) 'b2',b2(:,iti)
2015 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2016 c if (i .gt. iatel_s+2) then
2017 if (i .gt. nnt+2) then
2018 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2020 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2021 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2023 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
2024 c & EE(1,2,iti),EE(2,2,i)
2025 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2026 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2027 c write(iout,*) "Macierz EUG",
2028 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2031 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2033 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
2034 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
2035 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2036 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
2037 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
2049 DtUg2(l,k,i-2)=0.0d0
2053 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2054 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2056 muder(k,i-2)=Ub2der(k,i-2)
2058 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2059 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2060 if (itype(i-1).le.ntyp) then
2061 iti1 = itype2loc(itype(i-1))
2069 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2072 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
2073 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2074 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2075 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2076 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
2077 & ((ee(l,k,i-2),l=1,2),k=1,2)
2079 cd write (iout,*) 'mu1',mu1(:,i-2)
2080 cd write (iout,*) 'mu2',mu2(:,i-2)
2082 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2085 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2086 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
2087 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2088 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
2089 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2091 C Vectors and matrices dependent on a single virtual-bond dihedral.
2092 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
2093 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2094 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
2095 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
2096 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
2098 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2099 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
2100 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
2101 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
2107 C Matrices dependent on two consecutive virtual-bond dihedrals.
2108 C The order of matrices is from left to right.
2109 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2112 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2114 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2115 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2117 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2118 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2120 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2121 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2122 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2129 C--------------------------------------------------------------------------
2130 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2132 C This subroutine calculates the average interaction energy and its gradient
2133 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2134 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2135 C The potential depends both on the distance of peptide-group centers and on
2136 C the orientation of the CA-CA virtual bonds.
2138 implicit real*8 (a-h,o-z)
2142 include 'DIMENSIONS'
2143 include 'DIMENSIONS.ZSCOPT'
2144 include 'COMMON.CONTROL'
2145 include 'COMMON.IOUNITS'
2146 include 'COMMON.GEO'
2147 include 'COMMON.VAR'
2148 include 'COMMON.LOCAL'
2149 include 'COMMON.CHAIN'
2150 include 'COMMON.DERIV'
2151 include 'COMMON.INTERACT'
2153 include 'COMMON.CONTACTS'
2154 include 'COMMON.CONTMAT'
2156 include 'COMMON.CORRMAT'
2157 include 'COMMON.TORSION'
2158 include 'COMMON.VECTORS'
2159 include 'COMMON.FFIELD'
2160 include 'COMMON.TIME1'
2161 include 'COMMON.SPLITELE'
2162 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2163 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2164 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2165 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2166 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2167 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2169 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2171 double precision scal_el /1.0d0/
2173 double precision scal_el /0.5d0/
2176 C 13-go grudnia roku pamietnego...
2177 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2178 & 0.0d0,1.0d0,0.0d0,
2179 & 0.0d0,0.0d0,1.0d0/
2180 cd write(iout,*) 'In EELEC'
2182 cd write(iout,*) 'Type',i
2183 cd write(iout,*) 'B1',B1(:,i)
2184 cd write(iout,*) 'B2',B2(:,i)
2185 cd write(iout,*) 'CC',CC(:,:,i)
2186 cd write(iout,*) 'DD',DD(:,:,i)
2187 cd write(iout,*) 'EE',EE(:,:,i)
2189 cd call check_vecgrad
2191 if (icheckgrad.eq.1) then
2193 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2195 dc_norm(k,i)=dc(k,i)*fac
2197 c write (iout,*) 'i',i,' fac',fac
2200 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2201 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2202 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2203 c call vec_and_deriv
2209 time_mat=time_mat+MPI_Wtime()-time01
2213 cd write (iout,*) 'i=',i
2215 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2218 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2219 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2234 cd print '(a)','Enter EELEC'
2235 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2237 gel_loc_loc(i)=0.0d0
2242 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2244 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2246 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2247 do i=iturn3_start,iturn3_end
2249 C write(iout,*) "tu jest i",i
2250 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2251 C changes suggested by Ana to avoid out of bounds
2252 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2253 c & .or.((i+4).gt.nres)
2254 c & .or.((i-1).le.0)
2255 C end of changes by Ana
2256 C dobra zmiana wycofana
2257 & .or. itype(i+2).eq.ntyp1
2258 & .or. itype(i+3).eq.ntyp1) cycle
2259 C Adam: Instructions below will switch off existing interactions
2261 c if(itype(i-1).eq.ntyp1)cycle
2263 c if(i.LT.nres-3)then
2264 c if (itype(i+4).eq.ntyp1) cycle
2269 dx_normi=dc_norm(1,i)
2270 dy_normi=dc_norm(2,i)
2271 dz_normi=dc_norm(3,i)
2272 xmedi=c(1,i)+0.5d0*dxi
2273 ymedi=c(2,i)+0.5d0*dyi
2274 zmedi=c(3,i)+0.5d0*dzi
2275 xmedi=mod(xmedi,boxxsize)
2276 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2277 ymedi=mod(ymedi,boxysize)
2278 if (ymedi.lt.0) ymedi=ymedi+boxysize
2279 zmedi=mod(zmedi,boxzsize)
2280 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2282 call eelecij(i,i+2,ees,evdw1,eel_loc)
2283 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2285 num_cont_hb(i)=num_conti
2288 do i=iturn4_start,iturn4_end
2290 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2291 C changes suggested by Ana to avoid out of bounds
2292 c & .or.((i+5).gt.nres)
2293 c & .or.((i-1).le.0)
2294 C end of changes suggested by Ana
2295 & .or. itype(i+3).eq.ntyp1
2296 & .or. itype(i+4).eq.ntyp1
2297 c & .or. itype(i+5).eq.ntyp1
2298 c & .or. itype(i).eq.ntyp1
2299 c & .or. itype(i-1).eq.ntyp1
2304 dx_normi=dc_norm(1,i)
2305 dy_normi=dc_norm(2,i)
2306 dz_normi=dc_norm(3,i)
2307 xmedi=c(1,i)+0.5d0*dxi
2308 ymedi=c(2,i)+0.5d0*dyi
2309 zmedi=c(3,i)+0.5d0*dzi
2310 C Return atom into box, boxxsize is size of box in x dimension
2312 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2313 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2314 C Condition for being inside the proper box
2315 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2316 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2320 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2321 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2322 C Condition for being inside the proper box
2323 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2324 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2328 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2329 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2330 C Condition for being inside the proper box
2331 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2332 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2335 xmedi=mod(xmedi,boxxsize)
2336 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2337 ymedi=mod(ymedi,boxysize)
2338 if (ymedi.lt.0) ymedi=ymedi+boxysize
2339 zmedi=mod(zmedi,boxzsize)
2340 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2342 num_conti=num_cont_hb(i)
2344 c write(iout,*) "JESTEM W PETLI"
2345 call eelecij(i,i+3,ees,evdw1,eel_loc)
2346 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2347 & call eturn4(i,eello_turn4)
2349 num_cont_hb(i)=num_conti
2352 C Loop over all neighbouring boxes
2357 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2360 do i=iatel_s,iatel_e
2363 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2364 C changes suggested by Ana to avoid out of bounds
2365 c & .or.((i+2).gt.nres)
2366 c & .or.((i-1).le.0)
2367 C end of changes by Ana
2368 c & .or. itype(i+2).eq.ntyp1
2369 c & .or. itype(i-1).eq.ntyp1
2374 dx_normi=dc_norm(1,i)
2375 dy_normi=dc_norm(2,i)
2376 dz_normi=dc_norm(3,i)
2377 xmedi=c(1,i)+0.5d0*dxi
2378 ymedi=c(2,i)+0.5d0*dyi
2379 zmedi=c(3,i)+0.5d0*dzi
2380 xmedi=mod(xmedi,boxxsize)
2381 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2382 ymedi=mod(ymedi,boxysize)
2383 if (ymedi.lt.0) ymedi=ymedi+boxysize
2384 zmedi=mod(zmedi,boxzsize)
2385 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2386 C xmedi=xmedi+xshift*boxxsize
2387 C ymedi=ymedi+yshift*boxysize
2388 C zmedi=zmedi+zshift*boxzsize
2390 C Return tom into box, boxxsize is size of box in x dimension
2392 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2393 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2394 C Condition for being inside the proper box
2395 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2396 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2400 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2401 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2402 C Condition for being inside the proper box
2403 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2404 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2408 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2409 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2410 cC Condition for being inside the proper box
2411 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2412 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2416 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2418 num_conti=num_cont_hb(i)
2421 do j=ielstart(i),ielend(i)
2423 C write (iout,*) i,j
2425 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2426 C changes suggested by Ana to avoid out of bounds
2427 c & .or.((j+2).gt.nres)
2428 c & .or.((j-1).le.0)
2429 C end of changes by Ana
2430 c & .or.itype(j+2).eq.ntyp1
2431 c & .or.itype(j-1).eq.ntyp1
2433 call eelecij(i,j,ees,evdw1,eel_loc)
2436 num_cont_hb(i)=num_conti
2443 c write (iout,*) "Number of loop steps in EELEC:",ind
2445 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2446 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2448 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2449 ccc eel_loc=eel_loc+eello_turn3
2450 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2453 C-------------------------------------------------------------------------------
2454 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2455 implicit real*8 (a-h,o-z)
2456 include 'DIMENSIONS'
2457 include 'DIMENSIONS.ZSCOPT'
2461 include 'COMMON.CONTROL'
2462 include 'COMMON.IOUNITS'
2463 include 'COMMON.GEO'
2464 include 'COMMON.VAR'
2465 include 'COMMON.LOCAL'
2466 include 'COMMON.CHAIN'
2467 include 'COMMON.DERIV'
2468 include 'COMMON.INTERACT'
2470 include 'COMMON.CONTACTS'
2471 include 'COMMON.CONTMAT'
2473 include 'COMMON.CORRMAT'
2474 include 'COMMON.TORSION'
2475 include 'COMMON.VECTORS'
2476 include 'COMMON.FFIELD'
2477 include 'COMMON.TIME1'
2478 include 'COMMON.SPLITELE'
2479 include 'COMMON.SHIELD'
2480 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2481 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2482 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2483 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2484 & gmuij2(4),gmuji2(4)
2485 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2486 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2488 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2490 double precision scal_el /1.0d0/
2492 double precision scal_el /0.5d0/
2495 C 13-go grudnia roku pamietnego...
2496 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2497 & 0.0d0,1.0d0,0.0d0,
2498 & 0.0d0,0.0d0,1.0d0/
2499 integer xshift,yshift,zshift
2500 c time00=MPI_Wtime()
2501 cd write (iout,*) "eelecij",i,j
2505 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2506 aaa=app(iteli,itelj)
2507 bbb=bpp(iteli,itelj)
2508 ael6i=ael6(iteli,itelj)
2509 ael3i=ael3(iteli,itelj)
2513 dx_normj=dc_norm(1,j)
2514 dy_normj=dc_norm(2,j)
2515 dz_normj=dc_norm(3,j)
2516 C xj=c(1,j)+0.5D0*dxj-xmedi
2517 C yj=c(2,j)+0.5D0*dyj-ymedi
2518 C zj=c(3,j)+0.5D0*dzj-zmedi
2523 if (xj.lt.0) xj=xj+boxxsize
2525 if (yj.lt.0) yj=yj+boxysize
2527 if (zj.lt.0) zj=zj+boxzsize
2528 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2529 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2537 xj=xj_safe+xshift*boxxsize
2538 yj=yj_safe+yshift*boxysize
2539 zj=zj_safe+zshift*boxzsize
2540 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2541 if(dist_temp.lt.dist_init) then
2551 if (isubchap.eq.1) then
2560 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2562 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2563 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2564 C Condition for being inside the proper box
2565 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2566 c & (xj.lt.((-0.5d0)*boxxsize))) then
2570 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2571 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2572 C Condition for being inside the proper box
2573 c if ((yj.gt.((0.5d0)*boxysize)).or.
2574 c & (yj.lt.((-0.5d0)*boxysize))) then
2578 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2579 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2580 C Condition for being inside the proper box
2581 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2582 c & (zj.lt.((-0.5d0)*boxzsize))) then
2585 C endif !endPBC condintion
2589 rij=xj*xj+yj*yj+zj*zj
2591 sss=sscale(sqrt(rij))
2592 if (sss.eq.0.0d0) return
2593 sssgrad=sscagrad(sqrt(rij))
2594 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2595 c & " rlamb",rlamb," sss",sss
2596 c if (sss.gt.0.0d0) then
2602 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2603 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2604 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2605 fac=cosa-3.0D0*cosb*cosg
2607 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2608 if (j.eq.i+2) ev1=scal_el*ev1
2613 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2617 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2618 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2619 if (shield_mode.gt.0) then
2622 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2623 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2632 evdw1=evdw1+evdwij*sss
2633 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2634 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2635 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2636 cd & xmedi,ymedi,zmedi,xj,yj,zj
2638 if (energy_dec) then
2639 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2641 &,iteli,itelj,aaa,evdw1,sss
2642 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2643 &fac_shield(i),fac_shield(j)
2647 C Calculate contributions to the Cartesian gradient.
2650 facvdw=-6*rrmij*(ev1+evdwij)*sss
2651 facel=-3*rrmij*(el1+eesij)
2658 * Radial derivatives. First process both termini of the fragment (i,j)
2664 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2665 & (shield_mode.gt.0)) then
2667 do ilist=1,ishield_list(i)
2668 iresshield=shield_list(ilist,i)
2670 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2672 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2674 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2675 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2676 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2677 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2678 C if (iresshield.gt.i) then
2679 C do ishi=i+1,iresshield-1
2680 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2681 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2685 C do ishi=iresshield,i
2686 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2687 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2693 do ilist=1,ishield_list(j)
2694 iresshield=shield_list(ilist,j)
2696 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2698 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2700 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2701 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2703 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2704 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2705 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2706 C if (iresshield.gt.j) then
2707 C do ishi=j+1,iresshield-1
2708 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2709 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2713 C do ishi=iresshield,j
2714 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2715 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2722 gshieldc(k,i)=gshieldc(k,i)+
2723 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2724 gshieldc(k,j)=gshieldc(k,j)+
2725 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2726 gshieldc(k,i-1)=gshieldc(k,i-1)+
2727 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2728 gshieldc(k,j-1)=gshieldc(k,j-1)+
2729 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2734 c ghalf=0.5D0*ggg(k)
2735 c gelc(k,i)=gelc(k,i)+ghalf
2736 c gelc(k,j)=gelc(k,j)+ghalf
2738 c 9/28/08 AL Gradient compotents will be summed only at the end
2739 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2741 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2742 C & +grad_shield(k,j)*eesij/fac_shield(j)
2743 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2744 C & +grad_shield(k,i)*eesij/fac_shield(i)
2745 C gelc_long(k,i-1)=gelc_long(k,i-1)
2746 C & +grad_shield(k,i)*eesij/fac_shield(i)
2747 C gelc_long(k,j-1)=gelc_long(k,j-1)
2748 C & +grad_shield(k,j)*eesij/fac_shield(j)
2750 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2753 * Loop over residues i+1 thru j-1.
2757 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2760 if (sss.gt.0.0) then
2761 facvdw=facvdw+sssgrad*rmij*evdwij
2771 c ghalf=0.5D0*ggg(k)
2772 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2773 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2775 c 9/28/08 AL Gradient compotents will be summed only at the end
2777 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2778 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2781 * Loop over residues i+1 thru j-1.
2785 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2794 fac=-3*rrmij*(facvdw+facvdw+facel)*sss
2795 & +(evdwij+eesij)*sssgrad*rrmij
2800 * Radial derivatives. First process both termini of the fragment (i,j)
2804 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2806 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2808 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2810 c ghalf=0.5D0*ggg(k)
2811 c gelc(k,i)=gelc(k,i)+ghalf
2812 c gelc(k,j)=gelc(k,j)+ghalf
2814 c 9/28/08 AL Gradient compotents will be summed only at the end
2816 gelc_long(k,j)=gelc(k,j)+ggg(k)
2817 gelc_long(k,i)=gelc(k,i)-ggg(k)
2820 * Loop over residues i+1 thru j-1.
2824 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2827 c 9/28/08 AL Gradient compotents will be summed only at the end
2828 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2829 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2830 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2832 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2833 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2841 ecosa=2.0D0*fac3*fac1+fac4
2844 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2845 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2847 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2848 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2850 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2851 cd & (dcosg(k),k=1,3)
2853 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2854 & fac_shield(i)**2*fac_shield(j)**2
2857 c ghalf=0.5D0*ggg(k)
2858 c gelc(k,i)=gelc(k,i)+ghalf
2859 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2860 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2861 c gelc(k,j)=gelc(k,j)+ghalf
2862 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2863 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2867 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2870 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2873 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2874 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2875 & *fac_shield(i)**2*fac_shield(j)**2
2877 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2878 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2879 & *fac_shield(i)**2*fac_shield(j)**2
2880 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2881 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2883 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2888 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2889 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2890 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2892 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2893 C energy of a peptide unit is assumed in the form of a second-order
2894 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2895 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2896 C are computed for EVERY pair of non-contiguous peptide groups.
2899 if (j.lt.nres-1) then
2911 muij(kkk)=mu(k,i)*mu(l,j)
2912 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2915 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2916 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2917 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2918 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2919 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2920 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2926 write (iout,*) 'EELEC: i',i,' j',j
2927 write (iout,*) 'j',j,' j1',j1,' j2',j2
2928 write(iout,*) 'muij',muij
2929 write (iout,*) "uy",uy(:,i)
2930 write (iout,*) "uz",uz(:,j)
2931 write (iout,*) "erij",erij
2933 ury=scalar(uy(1,i),erij)
2934 urz=scalar(uz(1,i),erij)
2935 vry=scalar(uy(1,j),erij)
2936 vrz=scalar(uz(1,j),erij)
2937 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2938 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2939 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2940 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2941 fac=dsqrt(-ael6i)*r3ij
2946 cd write (iout,'(4i5,4f10.5)')
2947 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2948 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2949 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2950 cd & uy(:,j),uz(:,j)
2951 cd write (iout,'(4f10.5)')
2952 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2953 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2954 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2955 cd write (iout,'(9f10.5/)')
2956 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2957 C Derivatives of the elements of A in virtual-bond vectors
2959 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2961 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2962 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2963 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2964 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2965 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2966 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2967 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2968 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2969 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2970 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2971 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2972 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2974 C Compute radial contributions to the gradient
2992 C Add the contributions coming from er
2995 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2996 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2997 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2998 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3001 C Derivatives in DC(i)
3002 cgrad ghalf1=0.5d0*agg(k,1)
3003 cgrad ghalf2=0.5d0*agg(k,2)
3004 cgrad ghalf3=0.5d0*agg(k,3)
3005 cgrad ghalf4=0.5d0*agg(k,4)
3006 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3007 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3008 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3009 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3010 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3011 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3012 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3013 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3014 C Derivatives in DC(i+1)
3015 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3016 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3017 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3018 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3019 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3020 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3021 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3022 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3023 C Derivatives in DC(j)
3024 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3025 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3026 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3027 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3028 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3029 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3030 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3031 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3032 C Derivatives in DC(j+1) or DC(nres-1)
3033 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3034 & -3.0d0*vryg(k,3)*ury)
3035 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3036 & -3.0d0*vrzg(k,3)*ury)
3037 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3038 & -3.0d0*vryg(k,3)*urz)
3039 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3040 & -3.0d0*vrzg(k,3)*urz)
3041 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3043 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3058 aggi(k,l)=-aggi(k,l)
3059 aggi1(k,l)=-aggi1(k,l)
3060 aggj(k,l)=-aggj(k,l)
3061 aggj1(k,l)=-aggj1(k,l)
3065 if (j.lt.nres-1) then
3071 aggi(k,l)=-aggi(k,l)
3072 aggi1(k,l)=-aggi1(k,l)
3073 aggj(k,l)=-aggj(k,l)
3074 aggj1(k,l)=-aggj1(k,l)
3085 aggi(k,l)=-aggi(k,l)
3086 aggi1(k,l)=-aggi1(k,l)
3087 aggj(k,l)=-aggj(k,l)
3088 aggj1(k,l)=-aggj1(k,l)
3093 IF (wel_loc.gt.0.0d0) THEN
3094 C Contribution to the local-electrostatic energy coming from the i-j pair
3095 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3098 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
3100 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
3101 & " wel_loc",wel_loc
3103 if (shield_mode.eq.0) then
3110 eel_loc_ij=eel_loc_ij
3111 & *fac_shield(i)*fac_shield(j)*sss
3112 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3113 & 'eelloc',i,j,eel_loc_ij
3114 c if (eel_loc_ij.ne.0)
3115 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3116 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3118 eel_loc=eel_loc+eel_loc_ij
3119 C Now derivative over eel_loc
3121 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3122 & (shield_mode.gt.0)) then
3125 do ilist=1,ishield_list(i)
3126 iresshield=shield_list(ilist,i)
3128 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
3131 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3133 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
3134 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3138 do ilist=1,ishield_list(j)
3139 iresshield=shield_list(ilist,j)
3141 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
3144 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3146 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3147 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3154 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3155 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3156 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3157 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3158 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3159 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3160 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3161 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3166 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3167 c & ' eel_loc_ij',eel_loc_ij
3168 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3169 C Calculate patrial derivative for theta angle
3171 geel_loc_ij=(a22*gmuij1(1)
3175 & *fac_shield(i)*fac_shield(j)*sss
3176 c write(iout,*) "derivative over thatai"
3177 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3179 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3180 & geel_loc_ij*wel_loc
3181 c write(iout,*) "derivative over thatai-1"
3182 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3189 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3190 & geel_loc_ij*wel_loc
3191 & *fac_shield(i)*fac_shield(j)*sss
3193 c Derivative over j residue
3194 geel_loc_ji=a22*gmuji1(1)
3198 c write(iout,*) "derivative over thataj"
3199 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3202 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3203 & geel_loc_ji*wel_loc
3204 & *fac_shield(i)*fac_shield(j)
3211 c write(iout,*) "derivative over thataj-1"
3212 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3214 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3215 & geel_loc_ji*wel_loc
3216 & *fac_shield(i)*fac_shield(j)*sss
3218 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3220 C Partial derivatives in virtual-bond dihedral angles gamma
3222 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3223 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3224 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3225 & *fac_shield(i)*fac_shield(j)
3227 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3228 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3229 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3230 & *fac_shield(i)*fac_shield(j)
3231 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3232 aux=eel_loc_ij/sss*sssgrad*rmij
3237 ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
3238 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3239 & *fac_shield(i)*fac_shield(j)*sss
3240 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3241 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3242 cgrad ghalf=0.5d0*ggg(l)
3243 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3244 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3248 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3251 C Remaining derivatives of eello
3253 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3254 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3255 & *fac_shield(i)*fac_shield(j)
3257 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3258 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3259 & *fac_shield(i)*fac_shield(j)
3261 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3262 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3263 & *fac_shield(i)*fac_shield(j)
3265 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3266 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3267 & *fac_shield(i)*fac_shield(j)
3274 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3275 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3277 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3278 & .and. num_conti.le.maxconts) then
3279 c write (iout,*) i,j," entered corr"
3281 C Calculate the contact function. The ith column of the array JCONT will
3282 C contain the numbers of atoms that make contacts with the atom I (of numbers
3283 C greater than I). The arrays FACONT and GACONT will contain the values of
3284 C the contact function and its derivative.
3285 c r0ij=1.02D0*rpp(iteli,itelj)
3286 c r0ij=1.11D0*rpp(iteli,itelj)
3287 r0ij=2.20D0*rpp(iteli,itelj)
3288 c r0ij=1.55D0*rpp(iteli,itelj)
3289 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3290 if (fcont.gt.0.0D0) then
3291 num_conti=num_conti+1
3292 if (num_conti.gt.maxconts) then
3293 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3294 & ' will skip next contacts for this conf.'
3296 jcont_hb(num_conti,i)=j
3297 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3298 cd & " jcont_hb",jcont_hb(num_conti,i)
3299 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3300 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3301 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3303 d_cont(num_conti,i)=rij
3304 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3305 C --- Electrostatic-interaction matrix ---
3306 a_chuj(1,1,num_conti,i)=a22
3307 a_chuj(1,2,num_conti,i)=a23
3308 a_chuj(2,1,num_conti,i)=a32
3309 a_chuj(2,2,num_conti,i)=a33
3310 C --- Gradient of rij
3313 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3320 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3321 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3322 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3323 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3324 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3330 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3331 C Calculate contact energies
3333 wij=cosa-3.0D0*cosb*cosg
3336 c fac3=dsqrt(-ael6i)/r0ij**3
3337 fac3=dsqrt(-ael6i)*r3ij
3338 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3339 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3340 if (ees0tmp.gt.0) then
3341 ees0pij=dsqrt(ees0tmp)
3345 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3346 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3347 if (ees0tmp.gt.0) then
3348 ees0mij=dsqrt(ees0tmp)
3353 if (shield_mode.eq.0) then
3357 ees0plist(num_conti,i)=j
3358 C fac_shield(i)=0.4d0
3359 C fac_shield(j)=0.6d0
3361 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3362 & *fac_shield(i)*fac_shield(j)
3363 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3364 & *fac_shield(i)*fac_shield(j)
3365 C Diagnostics. Comment out or remove after debugging!
3366 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3367 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3368 c ees0m(num_conti,i)=0.0D0
3370 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3371 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3372 C Angular derivatives of the contact function
3374 ees0pij1=fac3/ees0pij
3375 ees0mij1=fac3/ees0mij
3376 fac3p=-3.0D0*fac3*rrmij
3377 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3378 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3380 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3381 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3382 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3383 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3384 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3385 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3386 ecosap=ecosa1+ecosa2
3387 ecosbp=ecosb1+ecosb2
3388 ecosgp=ecosg1+ecosg2
3389 ecosam=ecosa1-ecosa2
3390 ecosbm=ecosb1-ecosb2
3391 ecosgm=ecosg1-ecosg2
3400 facont_hb(num_conti,i)=fcont
3403 fprimcont=fprimcont/rij
3404 cd facont_hb(num_conti,i)=1.0D0
3405 C Following line is for diagnostics.
3408 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3409 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3412 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3413 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3415 gggp(1)=gggp(1)+ees0pijp*xj
3416 & +ees0p(num_conti,i)/sss*rmij*xj*sssgrad
3417 gggp(2)=gggp(2)+ees0pijp*yj
3418 & +ees0p(num_conti,i)/sss*rmij*yj*sssgrad
3419 gggp(3)=gggp(3)+ees0pijp*zj
3420 & +ees0p(num_conti,i)/sss*rmij*zj*sssgrad
3421 gggm(1)=gggm(1)+ees0mijp*xj
3422 & +ees0m(num_conti,i)/sss*rmij*xj*sssgrad
3423 gggm(2)=gggm(2)+ees0mijp*yj
3424 & +ees0m(num_conti,i)/sss*rmij*yj*sssgrad
3425 gggm(3)=gggm(3)+ees0mijp*zj
3426 & +ees0m(num_conti,i)/sss*rmij*zj*sssgrad
3427 C Derivatives due to the contact function
3428 gacont_hbr(1,num_conti,i)=fprimcont*xj
3429 gacont_hbr(2,num_conti,i)=fprimcont*yj
3430 gacont_hbr(3,num_conti,i)=fprimcont*zj
3433 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3434 c following the change of gradient-summation algorithm.
3436 cgrad ghalfp=0.5D0*gggp(k)
3437 cgrad ghalfm=0.5D0*gggm(k)
3438 gacontp_hb1(k,num_conti,i)=!ghalfp
3439 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3440 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3441 & *fac_shield(i)*fac_shield(j)*sss
3443 gacontp_hb2(k,num_conti,i)=!ghalfp
3444 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3445 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3446 & *fac_shield(i)*fac_shield(j)*sss
3448 gacontp_hb3(k,num_conti,i)=gggp(k)
3449 & *fac_shield(i)*fac_shield(j)*sss
3451 gacontm_hb1(k,num_conti,i)=!ghalfm
3452 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3453 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3454 & *fac_shield(i)*fac_shield(j)*sss
3456 gacontm_hb2(k,num_conti,i)=!ghalfm
3457 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3458 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3459 & *fac_shield(i)*fac_shield(j)*sss
3461 gacontm_hb3(k,num_conti,i)=gggm(k)
3462 & *fac_shield(i)*fac_shield(j)*sss
3465 C Diagnostics. Comment out or remove after debugging!
3467 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3468 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3469 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3470 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3471 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3472 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3478 endif ! num_conti.le.maxconts
3483 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3486 ghalf=0.5d0*agg(l,k)
3487 aggi(l,k)=aggi(l,k)+ghalf
3488 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3489 aggj(l,k)=aggj(l,k)+ghalf
3492 if (j.eq.nres-1 .and. i.lt.j-2) then
3495 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3501 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3504 C-----------------------------------------------------------------------------
3505 subroutine eturn3(i,eello_turn3)
3506 C Third- and fourth-order contributions from turns
3507 implicit real*8 (a-h,o-z)
3508 include 'DIMENSIONS'
3509 include 'DIMENSIONS.ZSCOPT'
3510 include 'COMMON.IOUNITS'
3511 include 'COMMON.GEO'
3512 include 'COMMON.VAR'
3513 include 'COMMON.LOCAL'
3514 include 'COMMON.CHAIN'
3515 include 'COMMON.DERIV'
3516 include 'COMMON.INTERACT'
3517 include 'COMMON.CONTACTS'
3518 include 'COMMON.TORSION'
3519 include 'COMMON.VECTORS'
3520 include 'COMMON.FFIELD'
3521 include 'COMMON.CONTROL'
3522 include 'COMMON.SHIELD'
3523 include 'COMMON.CORRMAT'
3525 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3526 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3527 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3528 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3529 & auxgmat2(2,2),auxgmatt2(2,2)
3530 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3531 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3532 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3533 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3536 c write (iout,*) "eturn3",i,j,j1,j2
3541 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3543 C Third-order contributions
3550 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3551 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3552 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3553 c auxalary matices for theta gradient
3554 c auxalary matrix for i+1 and constant i+2
3555 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3556 c auxalary matrix for i+2 and constant i+1
3557 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3558 call transpose2(auxmat(1,1),auxmat1(1,1))
3559 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3560 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3561 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3562 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3563 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3564 if (shield_mode.eq.0) then
3571 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3572 & *fac_shield(i)*fac_shield(j)
3573 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3574 & *fac_shield(i)*fac_shield(j)
3575 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3579 C Derivatives in theta
3580 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3581 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3582 & *fac_shield(i)*fac_shield(j)
3583 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3584 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3585 & *fac_shield(i)*fac_shield(j)
3588 C Derivatives in shield mode
3589 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3590 & (shield_mode.gt.0)) then
3593 do ilist=1,ishield_list(i)
3594 iresshield=shield_list(ilist,i)
3596 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3598 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3600 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3601 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3605 do ilist=1,ishield_list(j)
3606 iresshield=shield_list(ilist,j)
3608 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3610 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3612 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3613 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3620 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3621 & grad_shield(k,i)*eello_t3/fac_shield(i)
3622 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3623 & grad_shield(k,j)*eello_t3/fac_shield(j)
3624 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3625 & grad_shield(k,i)*eello_t3/fac_shield(i)
3626 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3627 & grad_shield(k,j)*eello_t3/fac_shield(j)
3631 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3632 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3633 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3634 cd & ' eello_turn3_num',4*eello_turn3_num
3635 C Derivatives in gamma(i)
3636 call matmat2(EUgder(1,1,i+1),EUg(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)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3640 & *fac_shield(i)*fac_shield(j)
3641 C Derivatives in gamma(i+1)
3642 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3643 call transpose2(auxmat2(1,1),auxmat3(1,1))
3644 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3645 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3646 & +0.5d0*(pizda(1,1)+pizda(2,2))
3647 & *fac_shield(i)*fac_shield(j)
3648 C Cartesian derivatives
3650 c ghalf1=0.5d0*agg(l,1)
3651 c ghalf2=0.5d0*agg(l,2)
3652 c ghalf3=0.5d0*agg(l,3)
3653 c ghalf4=0.5d0*agg(l,4)
3654 a_temp(1,1)=aggi(l,1)!+ghalf1
3655 a_temp(1,2)=aggi(l,2)!+ghalf2
3656 a_temp(2,1)=aggi(l,3)!+ghalf3
3657 a_temp(2,2)=aggi(l,4)!+ghalf4
3658 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3659 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3660 & +0.5d0*(pizda(1,1)+pizda(2,2))
3661 & *fac_shield(i)*fac_shield(j)
3663 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3664 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3665 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3666 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3667 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3668 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3669 & +0.5d0*(pizda(1,1)+pizda(2,2))
3670 & *fac_shield(i)*fac_shield(j)
3671 a_temp(1,1)=aggj(l,1)!+ghalf1
3672 a_temp(1,2)=aggj(l,2)!+ghalf2
3673 a_temp(2,1)=aggj(l,3)!+ghalf3
3674 a_temp(2,2)=aggj(l,4)!+ghalf4
3675 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3676 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3677 & +0.5d0*(pizda(1,1)+pizda(2,2))
3678 & *fac_shield(i)*fac_shield(j)
3679 a_temp(1,1)=aggj1(l,1)
3680 a_temp(1,2)=aggj1(l,2)
3681 a_temp(2,1)=aggj1(l,3)
3682 a_temp(2,2)=aggj1(l,4)
3683 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3684 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3685 & +0.5d0*(pizda(1,1)+pizda(2,2))
3686 & *fac_shield(i)*fac_shield(j)
3693 C-------------------------------------------------------------------------------
3694 subroutine eturn4(i,eello_turn4)
3695 C Third- and fourth-order contributions from turns
3696 implicit real*8 (a-h,o-z)
3697 include 'DIMENSIONS'
3698 include 'DIMENSIONS.ZSCOPT'
3699 include 'COMMON.IOUNITS'
3700 include 'COMMON.GEO'
3701 include 'COMMON.VAR'
3702 include 'COMMON.LOCAL'
3703 include 'COMMON.CHAIN'
3704 include 'COMMON.DERIV'
3705 include 'COMMON.INTERACT'
3706 include 'COMMON.CONTACTS'
3707 include 'COMMON.TORSION'
3708 include 'COMMON.VECTORS'
3709 include 'COMMON.FFIELD'
3710 include 'COMMON.CONTROL'
3711 include 'COMMON.SHIELD'
3712 include 'COMMON.CORRMAT'
3714 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3715 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3716 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3717 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3718 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3719 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3720 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3721 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3722 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3723 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3724 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3727 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3729 C Fourth-order contributions
3737 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3738 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3739 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3740 c write(iout,*)"WCHODZE W PROGRAM"
3745 iti1=itype2loc(itype(i+1))
3746 iti2=itype2loc(itype(i+2))
3747 iti3=itype2loc(itype(i+3))
3748 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3749 call transpose2(EUg(1,1,i+1),e1t(1,1))
3750 call transpose2(Eug(1,1,i+2),e2t(1,1))
3751 call transpose2(Eug(1,1,i+3),e3t(1,1))
3752 C Ematrix derivative in theta
3753 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3754 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3755 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3756 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3757 c eta1 in derivative theta
3758 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3759 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3760 c auxgvec is derivative of Ub2 so i+3 theta
3761 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3762 c auxalary matrix of E i+1
3763 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3766 s1=scalar2(b1(1,i+2),auxvec(1))
3767 c derivative of theta i+2 with constant i+3
3768 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3769 c derivative of theta i+2 with constant i+2
3770 gs32=scalar2(b1(1,i+2),auxgvec(1))
3771 c derivative of E matix in theta of i+1
3772 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3774 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3775 c ea31 in derivative theta
3776 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3777 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3778 c auxilary matrix auxgvec of Ub2 with constant E matirx
3779 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3780 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3781 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3785 s2=scalar2(b1(1,i+1),auxvec(1))
3786 c derivative of theta i+1 with constant i+3
3787 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3788 c derivative of theta i+2 with constant i+1
3789 gs21=scalar2(b1(1,i+1),auxgvec(1))
3790 c derivative of theta i+3 with constant i+1
3791 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3792 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3794 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3795 c two derivatives over diffetent matrices
3796 c gtae3e2 is derivative over i+3
3797 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3798 c ae3gte2 is derivative over i+2
3799 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3800 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3801 c three possible derivative over theta E matices
3803 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3805 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3807 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3808 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3810 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3811 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3812 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3813 if (shield_mode.eq.0) then
3820 eello_turn4=eello_turn4-(s1+s2+s3)
3821 & *fac_shield(i)*fac_shield(j)
3822 eello_t4=-(s1+s2+s3)
3823 & *fac_shield(i)*fac_shield(j)
3824 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3825 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3826 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3827 C Now derivative over shield:
3828 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3829 & (shield_mode.gt.0)) then
3832 do ilist=1,ishield_list(i)
3833 iresshield=shield_list(ilist,i)
3835 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3837 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3839 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3840 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3844 do ilist=1,ishield_list(j)
3845 iresshield=shield_list(ilist,j)
3847 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3849 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3851 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3852 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3859 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3860 & grad_shield(k,i)*eello_t4/fac_shield(i)
3861 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3862 & grad_shield(k,j)*eello_t4/fac_shield(j)
3863 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3864 & grad_shield(k,i)*eello_t4/fac_shield(i)
3865 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3866 & grad_shield(k,j)*eello_t4/fac_shield(j)
3869 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3870 cd & ' eello_turn4_num',8*eello_turn4_num
3872 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3873 & -(gs13+gsE13+gsEE1)*wturn4
3874 & *fac_shield(i)*fac_shield(j)
3875 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3876 & -(gs23+gs21+gsEE2)*wturn4
3877 & *fac_shield(i)*fac_shield(j)
3879 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3880 & -(gs32+gsE31+gsEE3)*wturn4
3881 & *fac_shield(i)*fac_shield(j)
3883 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3886 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3887 & 'eturn4',i,j,-(s1+s2+s3)
3888 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3889 c & ' eello_turn4_num',8*eello_turn4_num
3890 C Derivatives in gamma(i)
3891 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3892 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3893 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3894 s1=scalar2(b1(1,i+2),auxvec(1))
3895 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3896 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3897 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3898 & *fac_shield(i)*fac_shield(j)
3899 C Derivatives in gamma(i+1)
3900 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3901 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3902 s2=scalar2(b1(1,i+1),auxvec(1))
3903 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3904 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3905 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3906 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3907 & *fac_shield(i)*fac_shield(j)
3908 C Derivatives in gamma(i+2)
3909 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3910 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3911 s1=scalar2(b1(1,i+2),auxvec(1))
3912 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3913 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3914 s2=scalar2(b1(1,i+1),auxvec(1))
3915 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3916 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3917 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3918 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3919 & *fac_shield(i)*fac_shield(j)
3921 C Cartesian derivatives
3922 C Derivatives of this turn contributions in DC(i+2)
3923 if (j.lt.nres-1) then
3925 a_temp(1,1)=agg(l,1)
3926 a_temp(1,2)=agg(l,2)
3927 a_temp(2,1)=agg(l,3)
3928 a_temp(2,2)=agg(l,4)
3929 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3930 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3931 s1=scalar2(b1(1,i+2),auxvec(1))
3932 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3933 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3934 s2=scalar2(b1(1,i+1),auxvec(1))
3935 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3936 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3937 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3939 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3940 & *fac_shield(i)*fac_shield(j)
3943 C Remaining derivatives of this turn contribution
3945 a_temp(1,1)=aggi(l,1)
3946 a_temp(1,2)=aggi(l,2)
3947 a_temp(2,1)=aggi(l,3)
3948 a_temp(2,2)=aggi(l,4)
3949 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3950 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3951 s1=scalar2(b1(1,i+2),auxvec(1))
3952 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3953 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3954 s2=scalar2(b1(1,i+1),auxvec(1))
3955 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3956 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3957 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3958 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3959 & *fac_shield(i)*fac_shield(j)
3960 a_temp(1,1)=aggi1(l,1)
3961 a_temp(1,2)=aggi1(l,2)
3962 a_temp(2,1)=aggi1(l,3)
3963 a_temp(2,2)=aggi1(l,4)
3964 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3965 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3966 s1=scalar2(b1(1,i+2),auxvec(1))
3967 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3968 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3969 s2=scalar2(b1(1,i+1),auxvec(1))
3970 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3971 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3972 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3973 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3974 & *fac_shield(i)*fac_shield(j)
3975 a_temp(1,1)=aggj(l,1)
3976 a_temp(1,2)=aggj(l,2)
3977 a_temp(2,1)=aggj(l,3)
3978 a_temp(2,2)=aggj(l,4)
3979 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3980 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3981 s1=scalar2(b1(1,i+2),auxvec(1))
3982 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3983 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3984 s2=scalar2(b1(1,i+1),auxvec(1))
3985 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3986 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3987 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3988 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3989 & *fac_shield(i)*fac_shield(j)
3990 a_temp(1,1)=aggj1(l,1)
3991 a_temp(1,2)=aggj1(l,2)
3992 a_temp(2,1)=aggj1(l,3)
3993 a_temp(2,2)=aggj1(l,4)
3994 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3995 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3996 s1=scalar2(b1(1,i+2),auxvec(1))
3997 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3998 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3999 s2=scalar2(b1(1,i+1),auxvec(1))
4000 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4001 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4002 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4003 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4004 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4005 & *fac_shield(i)*fac_shield(j)
4012 C-----------------------------------------------------------------------------
4013 subroutine vecpr(u,v,w)
4014 implicit real*8(a-h,o-z)
4015 dimension u(3),v(3),w(3)
4016 w(1)=u(2)*v(3)-u(3)*v(2)
4017 w(2)=-u(1)*v(3)+u(3)*v(1)
4018 w(3)=u(1)*v(2)-u(2)*v(1)
4021 C-----------------------------------------------------------------------------
4022 subroutine unormderiv(u,ugrad,unorm,ungrad)
4023 C This subroutine computes the derivatives of a normalized vector u, given
4024 C the derivatives computed without normalization conditions, ugrad. Returns
4027 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4028 double precision vec(3)
4029 double precision scalar
4031 c write (2,*) 'ugrad',ugrad
4034 vec(i)=scalar(ugrad(1,i),u(1))
4036 c write (2,*) 'vec',vec
4039 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4042 c write (2,*) 'ungrad',ungrad
4045 C-----------------------------------------------------------------------------
4046 subroutine escp(evdw2,evdw2_14)
4048 C This subroutine calculates the excluded-volume interaction energy between
4049 C peptide-group centers and side chains and its gradient in virtual-bond and
4050 C side-chain vectors.
4052 implicit real*8 (a-h,o-z)
4053 include 'DIMENSIONS'
4054 include 'DIMENSIONS.ZSCOPT'
4055 include 'COMMON.CONTROL'
4056 include 'COMMON.GEO'
4057 include 'COMMON.VAR'
4058 include 'COMMON.LOCAL'
4059 include 'COMMON.CHAIN'
4060 include 'COMMON.DERIV'
4061 include 'COMMON.INTERACT'
4062 include 'COMMON.FFIELD'
4063 include 'COMMON.IOUNITS'
4067 cd print '(a)','Enter ESCP'
4068 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4069 c & ' scal14',scal14
4070 do i=iatscp_s,iatscp_e
4071 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4073 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4074 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4075 if (iteli.eq.0) goto 1225
4076 xi=0.5D0*(c(1,i)+c(1,i+1))
4077 yi=0.5D0*(c(2,i)+c(2,i+1))
4078 zi=0.5D0*(c(3,i)+c(3,i+1))
4079 C Returning the ith atom to box
4081 if (xi.lt.0) xi=xi+boxxsize
4083 if (yi.lt.0) yi=yi+boxysize
4085 if (zi.lt.0) zi=zi+boxzsize
4086 do iint=1,nscp_gr(i)
4088 do j=iscpstart(i,iint),iscpend(i,iint)
4089 itypj=iabs(itype(j))
4090 if (itypj.eq.ntyp1) cycle
4091 C Uncomment following three lines for SC-p interactions
4095 C Uncomment following three lines for Ca-p interactions
4099 C returning the jth atom to box
4101 if (xj.lt.0) xj=xj+boxxsize
4103 if (yj.lt.0) yj=yj+boxysize
4105 if (zj.lt.0) zj=zj+boxzsize
4106 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4111 C Finding the closest jth atom
4115 xj=xj_safe+xshift*boxxsize
4116 yj=yj_safe+yshift*boxysize
4117 zj=zj_safe+zshift*boxzsize
4118 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4119 if(dist_temp.lt.dist_init) then
4129 if (subchap.eq.1) then
4138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4139 C sss is scaling function for smoothing the cutoff gradient otherwise
4140 C the gradient would not be continuouse
4141 sss=sscale(1.0d0/(dsqrt(rrij)))
4142 if (sss.le.0.0d0) cycle
4143 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4145 e1=fac*fac*aad(itypj,iteli)
4146 e2=fac*bad(itypj,iteli)
4147 if (iabs(j-i) .le. 2) then
4150 evdw2_14=evdw2_14+(e1+e2)*sss
4153 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4154 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4155 c & bad(itypj,iteli)
4156 evdw2=evdw2+evdwij*sss
4157 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4158 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4163 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4165 fac=-(evdwij+e1)*rrij*sss
4166 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4171 cd write (iout,*) 'j<i'
4172 C Uncomment following three lines for SC-p interactions
4174 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4177 cd write (iout,*) 'j>i'
4180 C Uncomment following line for SC-p interactions
4181 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4185 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4189 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4190 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4193 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4203 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4204 gradx_scp(j,i)=expon*gradx_scp(j,i)
4207 C******************************************************************************
4211 C To save time the factor EXPON has been extracted from ALL components
4212 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4215 C******************************************************************************
4218 C--------------------------------------------------------------------------
4219 subroutine edis(ehpb)
4221 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4223 implicit real*8 (a-h,o-z)
4224 include 'DIMENSIONS'
4225 include 'DIMENSIONS.ZSCOPT'
4226 include 'COMMON.SBRIDGE'
4227 include 'COMMON.CHAIN'
4228 include 'COMMON.DERIV'
4229 include 'COMMON.VAR'
4230 include 'COMMON.INTERACT'
4231 include 'COMMON.CONTROL'
4232 include 'COMMON.IOUNITS'
4233 dimension ggg(3),ggg_peak(3,1000)
4238 c 8/21/18 AL: added explicit restraints on reference coords
4239 c write (iout,*) "restr_on_coord",restr_on_coord
4240 if (restr_on_coord) then
4244 if (itype(i).eq.ntyp1) cycle
4246 ecoor=ecoor+(c(j,i)-cref(j,i))**2
4247 ghpbc(j,i)=ghpbc(j,i)+bfac(i)*(c(j,i)-cref(j,i))
4249 if (itype(i).ne.10) then
4251 ecoor=ecoor+(c(j,i+nres)-cref(j,i+nres))**2
4252 ghpbx(j,i)=ghpbx(j,i)+bfac(i)*(c(j,i+nres)-cref(j,i+nres))
4255 if (energy_dec) write (iout,*)
4256 & "i",i," bfac",bfac(i)," ecoor",ecoor
4257 ehpb=ehpb+0.5d0*bfac(i)*ecoor
4262 C write (iout,*) ,"link_end",link_end,constr_dist
4263 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4264 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4265 c & " constr_dist",constr_dist
4266 if (link_end.eq.0.and.link_end_peak.eq.0) return
4267 do i=link_start_peak,link_end_peak
4269 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4270 c & ipeak(1,i),ipeak(2,i)
4271 do ip=ipeak(1,i),ipeak(2,i)
4276 C iii and jjj point to the residues for which the distance is assigned.
4277 c if (ii.gt.nres) then
4284 if (ii.gt.nres) then
4289 if (jj.gt.nres) then
4294 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4295 aux=dexp(-scal_peak*aux)
4296 ehpb_peak=ehpb_peak+aux
4297 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4298 & forcon_peak(ip))*aux/dd
4300 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4302 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4303 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4304 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4306 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4307 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4308 do ip=ipeak(1,i),ipeak(2,i)
4311 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4315 C iii and jjj point to the residues for which the distance is assigned.
4316 if (ii.gt.nres) then
4325 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4330 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4334 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4335 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4339 do i=link_start,link_end
4340 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4341 C CA-CA distance used in regularization of structure.
4344 C iii and jjj point to the residues for which the distance is assigned.
4345 if (ii.gt.nres) then
4350 if (jj.gt.nres) then
4355 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4356 c & dhpb(i),dhpb1(i),forcon(i)
4357 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4358 C distance and angle dependent SS bond potential.
4359 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4360 C & iabs(itype(jjj)).eq.1) then
4361 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4362 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4363 if (.not.dyn_ss .and. i.le.nss) then
4364 C 15/02/13 CC dynamic SSbond - additional check
4365 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4366 & iabs(itype(jjj)).eq.1) then
4367 call ssbond_ene(iii,jjj,eij)
4370 cd write (iout,*) "eij",eij
4371 cd & ' waga=',waga,' fac=',fac
4372 ! else if (ii.gt.nres .and. jj.gt.nres) then
4374 C Calculate the distance between the two points and its difference from the
4377 if (irestr_type(i).eq.11) then
4378 ehpb=ehpb+fordepth(i)!**4.0d0
4379 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4380 fac=fordepth(i)!**4.0d0
4381 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4382 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4383 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4384 & ehpb,irestr_type(i)
4385 else if (irestr_type(i).eq.10) then
4386 c AL 6//19/2018 cross-link restraints
4387 xdis = 0.5d0*(dd/forcon(i))**2
4388 expdis = dexp(-xdis)
4389 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4390 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4391 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4392 c & " wboltzd",wboltzd
4393 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4394 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4395 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4396 & *expdis/(aux*forcon(i)**2)
4397 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4398 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4399 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4400 else if (irestr_type(i).eq.2) then
4401 c Quartic restraints
4402 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4403 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4404 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4405 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4406 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4408 c Quadratic restraints
4410 C Get the force constant corresponding to this distance.
4412 C Calculate the contribution to energy.
4413 ehpb=ehpb+0.5d0*waga*rdis*rdis
4414 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4415 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4416 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4418 C Evaluate gradient.
4422 c Calculate Cartesian gradient
4424 ggg(j)=fac*(c(j,jj)-c(j,ii))
4426 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4427 C If this is a SC-SC distance, we need to calculate the contributions to the
4428 C Cartesian gradient in the SC vectors (ghpbx).
4431 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4436 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4440 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4441 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4447 C--------------------------------------------------------------------------
4448 subroutine ssbond_ene(i,j,eij)
4450 C Calculate the distance and angle dependent SS-bond potential energy
4451 C using a free-energy function derived based on RHF/6-31G** ab initio
4452 C calculations of diethyl disulfide.
4454 C A. Liwo and U. Kozlowska, 11/24/03
4456 implicit real*8 (a-h,o-z)
4457 include 'DIMENSIONS'
4458 include 'DIMENSIONS.ZSCOPT'
4459 include 'COMMON.SBRIDGE'
4460 include 'COMMON.CHAIN'
4461 include 'COMMON.DERIV'
4462 include 'COMMON.LOCAL'
4463 include 'COMMON.INTERACT'
4464 include 'COMMON.VAR'
4465 include 'COMMON.IOUNITS'
4466 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4467 itypi=iabs(itype(i))
4471 dxi=dc_norm(1,nres+i)
4472 dyi=dc_norm(2,nres+i)
4473 dzi=dc_norm(3,nres+i)
4474 dsci_inv=dsc_inv(itypi)
4475 itypj=iabs(itype(j))
4476 dscj_inv=dsc_inv(itypj)
4480 dxj=dc_norm(1,nres+j)
4481 dyj=dc_norm(2,nres+j)
4482 dzj=dc_norm(3,nres+j)
4483 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4488 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4489 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4490 om12=dxi*dxj+dyi*dyj+dzi*dzj
4492 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4493 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4499 deltat12=om2-om1+2.0d0
4501 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4502 & +akct*deltad*deltat12
4503 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4504 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4505 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4506 c & " deltat12",deltat12," eij",eij
4507 ed=2*akcm*deltad+akct*deltat12
4509 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4510 eom1=-2*akth*deltat1-pom1-om2*pom2
4511 eom2= 2*akth*deltat2+pom1-om1*pom2
4514 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4517 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4518 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4519 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4520 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4523 C Calculate the components of the gradient in DC and X
4527 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4532 C--------------------------------------------------------------------------
4533 c MODELLER restraint function
4534 subroutine e_modeller(ehomology_constr)
4535 implicit real*8 (a-h,o-z)
4536 include 'DIMENSIONS'
4537 include 'DIMENSIONS.ZSCOPT'
4538 include 'DIMENSIONS.FREE'
4539 integer nnn, i, j, k, ki, irec, l
4540 integer katy, odleglosci, test7
4541 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
4542 real*8 distance(max_template),distancek(max_template),
4543 & min_odl,godl(max_template),dih_diff(max_template)
4546 c FP - 30/10/2014 Temporary specifications for homology restraints
4548 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
4550 double precision, dimension (maxres) :: guscdiff,usc_diff
4551 double precision, dimension (max_template) ::
4552 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
4555 include 'COMMON.SBRIDGE'
4556 include 'COMMON.CHAIN'
4557 include 'COMMON.GEO'
4558 include 'COMMON.DERIV'
4559 include 'COMMON.LOCAL'
4560 include 'COMMON.INTERACT'
4561 include 'COMMON.VAR'
4562 include 'COMMON.IOUNITS'
4563 include 'COMMON.CONTROL'
4564 include 'COMMON.HOMRESTR'
4565 include 'COMMON.HOMOLOGY'
4566 include 'COMMON.SETUP'
4567 include 'COMMON.NAMES'
4570 distancek(i)=9999999.9
4575 c Pseudo-energy and gradient from homology restraints (MODELLER-like
4577 C AL 5/2/14 - Introduce list of restraints
4578 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
4580 write(iout,*) "------- dist restrs start -------"
4582 do ii = link_start_homo,link_end_homo
4586 c write (iout,*) "dij(",i,j,") =",dij
4588 do k=1,constr_homology
4589 if(.not.l_homo(k,ii)) then
4593 distance(k)=odl(k,ii)-dij
4594 c write (iout,*) "distance(",k,") =",distance(k)
4596 c For Gaussian-type Urestr
4598 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
4599 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
4600 c write (iout,*) "distancek(",k,") =",distancek(k)
4601 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
4603 c For Lorentzian-type Urestr
4605 if (waga_dist.lt.0.0d0) then
4606 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
4607 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
4608 & (distance(k)**2+sigma_odlir(k,ii)**2))
4612 c min_odl=minval(distancek)
4616 do kk=1,constr_homology
4617 if(l_homo(kk,ii)) then
4618 min_odl=distancek(kk)
4622 do kk=1,constr_homology
4623 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
4624 & min_odl=distancek(kk)
4627 c write (iout,* )"min_odl",min_odl
4629 write (iout,*) "ij dij",i,j,dij
4630 write (iout,*) "distance",(distance(k),k=1,constr_homology)
4631 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
4632 write (iout,* )"min_odl",min_odl
4637 if (waga_dist.ge.0.0d0) then
4643 do k=1,constr_homology
4644 c Nie wiem po co to liczycie jeszcze raz!
4645 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
4646 c & (2*(sigma_odl(i,j,k))**2))
4647 if(.not.l_homo(k,ii)) cycle
4648 if (waga_dist.ge.0.0d0) then
4650 c For Gaussian-type Urestr
4652 godl(k)=dexp(-distancek(k)+min_odl)
4653 odleg2=odleg2+godl(k)
4655 c For Lorentzian-type Urestr
4658 odleg2=odleg2+distancek(k)
4661 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
4662 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
4663 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
4664 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
4667 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4668 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4670 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
4671 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
4673 if (waga_dist.ge.0.0d0) then
4675 c For Gaussian-type Urestr
4677 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
4679 c For Lorentzian-type Urestr
4682 odleg=odleg+odleg2/constr_homology
4686 c write (iout,*) "odleg",odleg ! sum of -ln-s
4689 c For Gaussian-type Urestr
4691 if (waga_dist.ge.0.0d0) sum_godl=odleg2
4693 do k=1,constr_homology
4694 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4695 c & *waga_dist)+min_odl
4696 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
4698 if(.not.l_homo(k,ii)) cycle
4699 if (waga_dist.ge.0.0d0) then
4700 c For Gaussian-type Urestr
4702 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
4704 c For Lorentzian-type Urestr
4707 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
4708 & sigma_odlir(k,ii)**2)**2)
4710 sum_sgodl=sum_sgodl+sgodl
4712 c sgodl2=sgodl2+sgodl
4713 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
4714 c write(iout,*) "constr_homology=",constr_homology
4715 c write(iout,*) i, j, k, "TEST K"
4717 if (waga_dist.ge.0.0d0) then
4719 c For Gaussian-type Urestr
4721 grad_odl3=waga_homology(iset)*waga_dist
4722 & *sum_sgodl/(sum_godl*dij)
4724 c For Lorentzian-type Urestr
4727 c Original grad expr modified by analogy w Gaussian-type Urestr grad
4728 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
4729 grad_odl3=-waga_homology(iset)*waga_dist*
4730 & sum_sgodl/(constr_homology*dij)
4733 c grad_odl3=sum_sgodl/(sum_godl*dij)
4736 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
4737 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
4738 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
4740 ccc write(iout,*) godl, sgodl, grad_odl3
4742 c grad_odl=grad_odl+grad_odl3
4745 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
4746 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
4747 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
4748 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4749 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
4750 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
4751 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
4752 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
4753 c if (i.eq.25.and.j.eq.27) then
4754 c write(iout,*) "jik",jik,"i",i,"j",j
4755 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
4756 c write(iout,*) "grad_odl3",grad_odl3
4757 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
4758 c write(iout,*) "ggodl",ggodl
4759 c write(iout,*) "ghpbc(",jik,i,")",
4760 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
4765 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
4766 ccc & dLOG(odleg2),"-odleg=", -odleg
4768 enddo ! ii-loop for dist
4770 write(iout,*) "------- dist restrs end -------"
4771 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
4772 c & waga_d.eq.1.0d0) call sum_gradient
4774 c Pseudo-energy and gradient from dihedral-angle restraints from
4775 c homology templates
4776 c write (iout,*) "End of distance loop"
4779 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
4781 write(iout,*) "------- dih restrs start -------"
4782 do i=idihconstr_start_homo,idihconstr_end_homo
4783 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
4786 do i=idihconstr_start_homo,idihconstr_end_homo
4788 c betai=beta(i,i+1,i+2,i+3)
4790 c write (iout,*) "betai =",betai
4791 do k=1,constr_homology
4792 dih_diff(k)=pinorm(dih(k,i)-betai)
4793 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
4794 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
4795 c & -(6.28318-dih_diff(i,k))
4796 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
4797 c & 6.28318+dih_diff(i,k)
4799 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
4801 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i)
4803 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
4806 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
4809 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
4810 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
4812 write (iout,*) "i",i," betai",betai," kat2",kat2
4813 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
4815 if (kat2.le.1.0d-14) cycle
4816 kat=kat-dLOG(kat2/constr_homology)
4817 c write (iout,*) "kat",kat ! sum of -ln-s
4819 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
4820 ccc & dLOG(kat2), "-kat=", -kat
4823 c ----------------------------------------------------------------------
4825 c ----------------------------------------------------------------------
4829 do k=1,constr_homology
4831 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
4833 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i)
4835 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
4836 sum_sgdih=sum_sgdih+sgdih
4838 c grad_dih3=sum_sgdih/sum_gdih
4839 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
4841 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
4842 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
4843 ccc & gloc(nphi+i-3,icg)
4844 gloc(i,icg)=gloc(i,icg)+grad_dih3
4846 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
4848 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
4849 ccc & gloc(nphi+i-3,icg)
4851 enddo ! i-loop for dih
4853 write(iout,*) "------- dih restrs end -------"
4856 c Pseudo-energy and gradient for theta angle restraints from
4857 c homology templates
4858 c FP 01/15 - inserted from econstr_local_test.F, loop structure
4862 c For constr_homology reference structures (FP)
4864 c Uconst_back_tot=0.0d0
4867 c Econstr_back legacy
4870 c do i=ithet_start,ithet_end
4873 c do i=loc_start,loc_end
4876 duscdiffx(j,i)=0.0d0
4882 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
4883 c write (iout,*) "waga_theta",waga_theta
4884 if (waga_theta.gt.0.0d0) then
4886 write (iout,*) "usampl",usampl
4887 write(iout,*) "------- theta restrs start -------"
4888 c do i=ithet_start,ithet_end
4889 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
4892 c write (iout,*) "maxres",maxres,"nres",nres
4894 do i=ithet_start,ithet_end
4897 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
4899 c Deviation of theta angles wrt constr_homology ref structures
4901 utheta_i=0.0d0 ! argument of Gaussian for single k
4902 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4903 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
4904 c over residues in a fragment
4905 c write (iout,*) "theta(",i,")=",theta(i)
4906 do k=1,constr_homology
4908 c dtheta_i=theta(j)-thetaref(j,iref)
4909 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
4910 theta_diff(k)=thetatpl(k,i)-theta(i)
4912 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
4913 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
4914 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
4915 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
4916 c Gradient for single Gaussian restraint in subr Econstr_back
4917 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
4920 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
4921 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
4925 c Gradient for multiple Gaussian restraint
4926 sum_gtheta=gutheta_i
4928 do k=1,constr_homology
4929 c New generalized expr for multiple Gaussian from Econstr_back
4930 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
4932 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
4933 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
4936 c Final value of gradient using same var as in Econstr_back
4937 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
4938 & *waga_homology(iset)
4939 c dutheta(i)=sum_sgtheta/sum_gtheta
4941 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
4943 Eval=Eval-dLOG(gutheta_i/constr_homology)
4944 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
4945 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
4946 c Uconst_back=Uconst_back+utheta(i)
4947 enddo ! (i-loop for theta)
4949 write(iout,*) "------- theta restrs end -------"
4953 c Deviation of local SC geometry
4955 c Separation of two i-loops (instructed by AL - 11/3/2014)
4957 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
4958 c write (iout,*) "waga_d",waga_d
4961 write(iout,*) "------- SC restrs start -------"
4962 write (iout,*) "Initial duscdiff,duscdiffx"
4963 do i=loc_start,loc_end
4964 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
4965 & (duscdiffx(jik,i),jik=1,3)
4968 do i=loc_start,loc_end
4969 usc_diff_i=0.0d0 ! argument of Gaussian for single k
4970 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
4971 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
4972 c write(iout,*) "xxtab, yytab, zztab"
4973 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
4974 do k=1,constr_homology
4976 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
4977 c Original sign inverted for calc of gradients (s. Econstr_back)
4978 dyy=-yytpl(k,i)+yytab(i) ! ibid y
4979 dzz=-zztpl(k,i)+zztab(i) ! ibid z
4980 c write(iout,*) "dxx, dyy, dzz"
4981 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
4983 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
4984 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
4985 c uscdiffk(k)=usc_diff(i)
4986 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
4987 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
4988 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
4989 c & xxref(j),yyref(j),zzref(j)
4994 c Generalized expression for multiple Gaussian acc to that for a single
4995 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
4997 c Original implementation
4998 c sum_guscdiff=guscdiff(i)
5000 c sum_sguscdiff=0.0d0
5001 c do k=1,constr_homology
5002 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
5003 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
5004 c sum_sguscdiff=sum_sguscdiff+sguscdiff
5007 c Implementation of new expressions for gradient (Jan. 2015)
5009 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
5011 do k=1,constr_homology
5013 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
5014 c before. Now the drivatives should be correct
5016 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
5017 c Original sign inverted for calc of gradients (s. Econstr_back)
5018 dyy=-yytpl(k,i)+yytab(i) ! ibid y
5019 dzz=-zztpl(k,i)+zztab(i) ! ibid z
5021 c New implementation
5023 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
5024 & sigma_d(k,i) ! for the grad wrt r'
5025 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
5028 c New implementation
5029 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
5031 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
5032 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
5033 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
5034 duscdiff(jik,i)=duscdiff(jik,i)+
5035 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
5036 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
5037 duscdiffx(jik,i)=duscdiffx(jik,i)+
5038 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
5039 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
5042 write(iout,*) "jik",jik,"i",i
5043 write(iout,*) "dxx, dyy, dzz"
5044 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
5045 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
5046 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
5047 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
5048 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
5049 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
5050 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
5051 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
5052 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
5053 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
5054 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
5055 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
5056 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
5057 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
5058 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
5065 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
5066 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
5068 c write (iout,*) i," uscdiff",uscdiff(i)
5070 c Put together deviations from local geometry
5072 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
5073 c & wfrag_back(3,i,iset)*uscdiff(i)
5074 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
5075 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
5076 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
5077 c Uconst_back=Uconst_back+usc_diff(i)
5079 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
5081 c New implment: multiplied by sum_sguscdiff
5084 enddo ! (i-loop for dscdiff)
5089 write(iout,*) "------- SC restrs end -------"
5090 write (iout,*) "------ After SC loop in e_modeller ------"
5091 do i=loc_start,loc_end
5092 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
5093 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
5095 if (waga_theta.eq.1.0d0) then
5096 write (iout,*) "in e_modeller after SC restr end: dutheta"
5097 do i=ithet_start,ithet_end
5098 write (iout,*) i,dutheta(i)
5101 if (waga_d.eq.1.0d0) then
5102 write (iout,*) "e_modeller after SC loop: duscdiff/x"
5104 write (iout,*) i,(duscdiff(j,i),j=1,3)
5105 write (iout,*) i,(duscdiffx(j,i),j=1,3)
5110 c Total energy from homology restraints
5112 write (iout,*) "odleg",odleg," kat",kat
5113 write (iout,*) "odleg",odleg," kat",kat
5114 write (iout,*) "Eval",Eval," Erot",Erot
5115 write (iout,*) "waga_homology(",iset,")",waga_homology(iset)
5116 write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle
5117 write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d
5120 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
5122 c ehomology_constr=odleg+kat
5124 c For Lorentzian-type Urestr
5127 if (waga_dist.ge.0.0d0) then
5129 c For Gaussian-type Urestr
5131 c ehomology_constr=(waga_dist*odleg+waga_angle*kat+
5132 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
5133 ehomology_constr=waga_dist*odleg+waga_angle*kat+
5134 & waga_theta*Eval+waga_d*Erot
5135 c write (iout,*) "ehomology_constr=",ehomology_constr
5138 c For Lorentzian-type Urestr
5140 c ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
5141 c & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
5142 ehomology_constr=-waga_dist*odleg+waga_angle*kat+
5143 & waga_theta*Eval+waga_d*Erot
5144 c write (iout,*) "ehomology_constr=",ehomology_constr
5147 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
5148 & "Eval",waga_theta,eval,
5149 & "Erot",waga_d,Erot
5150 write (iout,*) "ehomology_constr",ehomology_constr
5154 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
5155 747 format(a12,i4,i4,i4,f8.3,f8.3)
5156 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
5157 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
5158 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
5159 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
5161 c-----------------------------------------------------------------------
5162 subroutine ebond(estr)
5164 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5166 implicit real*8 (a-h,o-z)
5167 include 'DIMENSIONS'
5168 include 'DIMENSIONS.ZSCOPT'
5169 include 'COMMON.LOCAL'
5170 include 'COMMON.GEO'
5171 include 'COMMON.INTERACT'
5172 include 'COMMON.DERIV'
5173 include 'COMMON.VAR'
5174 include 'COMMON.CHAIN'
5175 include 'COMMON.IOUNITS'
5176 include 'COMMON.NAMES'
5177 include 'COMMON.FFIELD'
5178 include 'COMMON.CONTROL'
5179 double precision u(3),ud(3)
5182 c write (iout,*) "distchainmax",distchainmax
5185 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
5186 diff = vbld(i)-vbldp0
5188 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5189 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5191 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5192 C & *dc(j,i-1)/vbld(i)
5194 C if (energy_dec) write(iout,*)
5195 C & "estr1",i,vbld(i),distchainmax,
5196 C & gnmr1(vbld(i),-1.0d0,distchainmax)
5198 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5199 diff = vbld(i)-vbldpDUM
5200 C write(iout,*) i,diff
5202 diff = vbld(i)-vbldp0
5203 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
5208 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5211 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5212 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5214 estr=0.5d0*AKP*estr+estr1
5216 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5220 if (iti.ne.10 .and. iti.ne.ntyp1) then
5223 diff=vbld(i+nres)-vbldsc0(1,iti)
5224 if (energy_dec) write (iout,*) "estr sc",iti,vbld(i+nres),
5225 & vbldsc0(1,iti),diff,
5226 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5227 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5229 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5233 diff=vbld(i+nres)-vbldsc0(j,iti)
5234 ud(j)=aksc(j,iti)*diff
5235 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5249 uprod2=uprod2*u(k)*u(k)
5253 usumsqder=usumsqder+ud(j)*uprod2
5255 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
5256 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
5257 estr=estr+uprod/usum
5259 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5267 C--------------------------------------------------------------------------
5268 subroutine ebend(etheta,ethetacnstr)
5270 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5271 C angles gamma and its derivatives in consecutive thetas and gammas.
5273 implicit real*8 (a-h,o-z)
5274 include 'DIMENSIONS'
5275 include 'DIMENSIONS.ZSCOPT'
5276 include 'COMMON.LOCAL'
5277 include 'COMMON.GEO'
5278 include 'COMMON.INTERACT'
5279 include 'COMMON.DERIV'
5280 include 'COMMON.VAR'
5281 include 'COMMON.CHAIN'
5282 include 'COMMON.IOUNITS'
5283 include 'COMMON.NAMES'
5284 include 'COMMON.FFIELD'
5285 include 'COMMON.TORCNSTR'
5286 common /calcthet/ term1,term2,termm,diffak,ratak,
5287 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5288 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5289 double precision y(2),z(2)
5291 c time11=dexp(-2*time)
5294 c write (iout,*) "nres",nres
5295 c write (*,'(a,i2)') 'EBEND ICG=',icg
5296 c write (iout,*) ithet_start,ithet_end
5297 do i=ithet_start,ithet_end
5298 C if (itype(i-1).eq.ntyp1) cycle
5300 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5301 & .or.itype(i).eq.ntyp1) cycle
5302 C Zero the energy function and its derivative at 0 or pi.
5303 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5305 ichir1=isign(1,itype(i-2))
5306 ichir2=isign(1,itype(i))
5307 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5308 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5309 if (itype(i-1).eq.10) then
5310 itype1=isign(10,itype(i-2))
5311 ichir11=isign(1,itype(i-2))
5312 ichir12=isign(1,itype(i-2))
5313 itype2=isign(10,itype(i))
5314 ichir21=isign(1,itype(i))
5315 ichir22=isign(1,itype(i))
5322 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5326 c call proc_proc(phii,icrc)
5327 if (icrc.eq.1) phii=150.0
5338 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5342 c call proc_proc(phii1,icrc)
5343 if (icrc.eq.1) phii1=150.0
5355 C Calculate the "mean" value of theta from the part of the distribution
5356 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5357 C In following comments this theta will be referred to as t_c.
5358 thet_pred_mean=0.0d0
5360 athetk=athet(k,it,ichir1,ichir2)
5361 bthetk=bthet(k,it,ichir1,ichir2)
5363 athetk=athet(k,itype1,ichir11,ichir12)
5364 bthetk=bthet(k,itype2,ichir21,ichir22)
5366 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5368 c write (iout,*) "thet_pred_mean",thet_pred_mean
5369 dthett=thet_pred_mean*ssd
5370 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5371 c write (iout,*) "thet_pred_mean",thet_pred_mean
5372 C Derivatives of the "mean" values in gamma1 and gamma2.
5373 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5374 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5375 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5376 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5378 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5379 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5380 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5381 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5383 if (theta(i).gt.pi-delta) then
5384 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5386 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5387 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5388 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5390 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5392 else if (theta(i).lt.delta) then
5393 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5394 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5395 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5397 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5398 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5401 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5404 etheta=etheta+ethetai
5405 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5406 c & 'ebend',i,ethetai,theta(i),itype(i)
5407 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5408 c & rad2deg*phii,rad2deg*phii1,ethetai
5409 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5410 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5411 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5415 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5416 do i=1,ntheta_constr
5417 itheta=itheta_constr(i)
5418 thetiii=theta(itheta)
5419 difi=pinorm(thetiii-theta_constr0(i))
5420 if (difi.gt.theta_drange(i)) then
5421 difi=difi-theta_drange(i)
5422 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5423 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5424 & +for_thet_constr(i)*difi**3
5425 else if (difi.lt.-drange(i)) then
5427 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5428 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5429 & +for_thet_constr(i)*difi**3
5433 C if (energy_dec) then
5434 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5435 C & i,itheta,rad2deg*thetiii,
5436 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5437 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5438 C & gloc(itheta+nphi-2,icg)
5441 C Ufff.... We've done all this!!!
5444 C---------------------------------------------------------------------------
5445 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5447 implicit real*8 (a-h,o-z)
5448 include 'DIMENSIONS'
5449 include 'COMMON.LOCAL'
5450 include 'COMMON.IOUNITS'
5451 common /calcthet/ term1,term2,termm,diffak,ratak,
5452 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5453 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5454 C Calculate the contributions to both Gaussian lobes.
5455 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5456 C The "polynomial part" of the "standard deviation" of this part of
5460 sig=sig*thet_pred_mean+polthet(j,it)
5462 C Derivative of the "interior part" of the "standard deviation of the"
5463 C gamma-dependent Gaussian lobe in t_c.
5464 sigtc=3*polthet(3,it)
5466 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5469 C Set the parameters of both Gaussian lobes of the distribution.
5470 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5471 fac=sig*sig+sigc0(it)
5474 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5475 sigsqtc=-4.0D0*sigcsq*sigtc
5476 c print *,i,sig,sigtc,sigsqtc
5477 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5478 sigtc=-sigtc/(fac*fac)
5479 C Following variable is sigma(t_c)**(-2)
5480 sigcsq=sigcsq*sigcsq
5482 sig0inv=1.0D0/sig0i**2
5483 delthec=thetai-thet_pred_mean
5484 delthe0=thetai-theta0i
5485 term1=-0.5D0*sigcsq*delthec*delthec
5486 term2=-0.5D0*sig0inv*delthe0*delthe0
5487 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5488 C NaNs in taking the logarithm. We extract the largest exponent which is added
5489 C to the energy (this being the log of the distribution) at the end of energy
5490 C term evaluation for this virtual-bond angle.
5491 if (term1.gt.term2) then
5493 term2=dexp(term2-termm)
5497 term1=dexp(term1-termm)
5500 C The ratio between the gamma-independent and gamma-dependent lobes of
5501 C the distribution is a Gaussian function of thet_pred_mean too.
5502 diffak=gthet(2,it)-thet_pred_mean
5503 ratak=diffak/gthet(3,it)**2
5504 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5505 C Let's differentiate it in thet_pred_mean NOW.
5507 C Now put together the distribution terms to make complete distribution.
5508 termexp=term1+ak*term2
5509 termpre=sigc+ak*sig0i
5510 C Contribution of the bending energy from this theta is just the -log of
5511 C the sum of the contributions from the two lobes and the pre-exponential
5512 C factor. Simple enough, isn't it?
5513 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5514 C NOW the derivatives!!!
5515 C 6/6/97 Take into account the deformation.
5516 E_theta=(delthec*sigcsq*term1
5517 & +ak*delthe0*sig0inv*term2)/termexp
5518 E_tc=((sigtc+aktc*sig0i)/termpre
5519 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5520 & aktc*term2)/termexp)
5523 c-----------------------------------------------------------------------------
5524 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5525 implicit real*8 (a-h,o-z)
5526 include 'DIMENSIONS'
5527 include 'COMMON.LOCAL'
5528 include 'COMMON.IOUNITS'
5529 common /calcthet/ term1,term2,termm,diffak,ratak,
5530 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5531 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5532 delthec=thetai-thet_pred_mean
5533 delthe0=thetai-theta0i
5534 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5535 t3 = thetai-thet_pred_mean
5539 t14 = t12+t6*sigsqtc
5541 t21 = thetai-theta0i
5547 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5548 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5549 & *(-t12*t9-ak*sig0inv*t27)
5553 C--------------------------------------------------------------------------
5554 subroutine ebend(etheta)
5556 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5557 C angles gamma and its derivatives in consecutive thetas and gammas.
5558 C ab initio-derived potentials from
5559 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5561 implicit real*8 (a-h,o-z)
5562 include 'DIMENSIONS'
5563 include 'DIMENSIONS.ZSCOPT'
5564 include 'COMMON.LOCAL'
5565 include 'COMMON.GEO'
5566 include 'COMMON.INTERACT'
5567 include 'COMMON.DERIV'
5568 include 'COMMON.VAR'
5569 include 'COMMON.CHAIN'
5570 include 'COMMON.IOUNITS'
5571 include 'COMMON.NAMES'
5572 include 'COMMON.FFIELD'
5573 include 'COMMON.CONTROL'
5574 include 'COMMON.TORCNSTR'
5575 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5576 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5577 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5578 & sinph1ph2(maxdouble,maxdouble)
5579 logical lprn /.false./, lprn1 /.false./
5581 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5582 do i=ithet_start,ithet_end
5584 C if (itype(i-1).eq.ntyp1) cycle
5586 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5587 & .or.itype(i).eq.ntyp1) cycle
5588 if (iabs(itype(i+1)).eq.20) iblock=2
5589 if (iabs(itype(i+1)).ne.20) iblock=1
5593 theti2=0.5d0*theta(i)
5594 ityp2=ithetyp((itype(i-1)))
5596 coskt(k)=dcos(k*theti2)
5597 sinkt(k)=dsin(k*theti2)
5607 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5610 if (phii.ne.phii) phii=150.0
5614 ityp1=ithetyp((itype(i-2)))
5616 cosph1(k)=dcos(k*phii)
5617 sinph1(k)=dsin(k*phii)
5623 ityp1=ithetyp((itype(i-2)))
5628 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5631 if (phii1.ne.phii1) phii1=150.0
5636 ityp3=ithetyp((itype(i)))
5638 cosph2(k)=dcos(k*phii1)
5639 sinph2(k)=dsin(k*phii1)
5644 ityp3=ithetyp((itype(i)))
5650 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5651 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5653 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5656 ccl=cosph1(l)*cosph2(k-l)
5657 ssl=sinph1(l)*sinph2(k-l)
5658 scl=sinph1(l)*cosph2(k-l)
5659 csl=cosph1(l)*sinph2(k-l)
5660 cosph1ph2(l,k)=ccl-ssl
5661 cosph1ph2(k,l)=ccl+ssl
5662 sinph1ph2(l,k)=scl+csl
5663 sinph1ph2(k,l)=scl-csl
5667 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5668 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5669 write (iout,*) "coskt and sinkt"
5671 write (iout,*) k,coskt(k),sinkt(k)
5675 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5676 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5679 & write (iout,*) "k",k,"
5680 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5681 & " ethetai",ethetai
5684 write (iout,*) "cosph and sinph"
5686 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5688 write (iout,*) "cosph1ph2 and sinph2ph2"
5691 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5692 & sinph1ph2(l,k),sinph1ph2(k,l)
5695 write(iout,*) "ethetai",ethetai
5699 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5700 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5701 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5702 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5703 ethetai=ethetai+sinkt(m)*aux
5704 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5705 dephii=dephii+k*sinkt(m)*(
5706 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5707 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5708 dephii1=dephii1+k*sinkt(m)*(
5709 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5710 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5712 & write (iout,*) "m",m," k",k," bbthet",
5713 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5714 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5715 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5716 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5720 & write(iout,*) "ethetai",ethetai
5724 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5725 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5726 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5727 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5728 ethetai=ethetai+sinkt(m)*aux
5729 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5730 dephii=dephii+l*sinkt(m)*(
5731 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5732 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5733 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5734 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5735 dephii1=dephii1+(k-l)*sinkt(m)*(
5736 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5737 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5738 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5739 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5741 write (iout,*) "m",m," k",k," l",l," ffthet",
5742 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5743 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5744 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5745 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5746 & " ethetai",ethetai
5747 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5748 & cosph1ph2(k,l)*sinkt(m),
5749 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5755 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5756 & i,theta(i)*rad2deg,phii*rad2deg,
5757 & phii1*rad2deg,ethetai
5758 etheta=etheta+ethetai
5759 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5760 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5761 c gloc(nphi+i-2,icg)=wang*dethetai
5762 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5768 c-----------------------------------------------------------------------------
5769 subroutine esc(escloc)
5770 C Calculate the local energy of a side chain and its derivatives in the
5771 C corresponding virtual-bond valence angles THETA and the spherical angles
5773 implicit real*8 (a-h,o-z)
5774 include 'DIMENSIONS'
5775 include 'DIMENSIONS.ZSCOPT'
5776 include 'COMMON.GEO'
5777 include 'COMMON.LOCAL'
5778 include 'COMMON.VAR'
5779 include 'COMMON.INTERACT'
5780 include 'COMMON.DERIV'
5781 include 'COMMON.CHAIN'
5782 include 'COMMON.IOUNITS'
5783 include 'COMMON.NAMES'
5784 include 'COMMON.FFIELD'
5785 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5786 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5787 common /sccalc/ time11,time12,time112,theti,it,nlobit
5790 C write (iout,*) 'ESC'
5791 do i=loc_start,loc_end
5793 if (it.eq.ntyp1) cycle
5794 if (it.eq.10) goto 1
5795 nlobit=nlob(iabs(it))
5796 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5797 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5798 theti=theta(i+1)-pipol
5802 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5804 if (x(2).gt.pi-delta) then
5808 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5810 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5811 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5813 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5814 & ddersc0(1),dersc(1))
5815 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5816 & ddersc0(3),dersc(3))
5818 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5820 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5821 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5822 & dersc0(2),esclocbi,dersc02)
5823 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5825 call splinthet(x(2),0.5d0*delta,ss,ssd)
5830 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5832 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5833 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5835 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5837 c write (iout,*) escloci
5838 else if (x(2).lt.delta) then
5842 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5844 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5845 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5847 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5848 & ddersc0(1),dersc(1))
5849 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5850 & ddersc0(3),dersc(3))
5852 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5854 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5855 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5856 & dersc0(2),esclocbi,dersc02)
5857 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5862 call splinthet(x(2),0.5d0*delta,ss,ssd)
5864 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5866 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5867 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5869 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5870 C write (iout,*) 'i=',i, escloci
5872 call enesc(x,escloci,dersc,ddummy,.false.)
5875 escloc=escloc+escloci
5876 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5877 write (iout,'(a6,i5,0pf7.3)')
5878 & 'escloc',i,escloci
5880 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5882 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5883 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5888 C---------------------------------------------------------------------------
5889 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5890 implicit real*8 (a-h,o-z)
5891 include 'DIMENSIONS'
5892 include 'COMMON.GEO'
5893 include 'COMMON.LOCAL'
5894 include 'COMMON.IOUNITS'
5895 common /sccalc/ time11,time12,time112,theti,it,nlobit
5896 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5897 double precision contr(maxlob,-1:1)
5899 c write (iout,*) 'it=',it,' nlobit=',nlobit
5903 if (mixed) ddersc(j)=0.0d0
5907 C Because of periodicity of the dependence of the SC energy in omega we have
5908 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5909 C To avoid underflows, first compute & store the exponents.
5917 z(k)=x(k)-censc(k,j,it)
5922 Axk=Axk+gaussc(l,k,j,it)*z(l)
5928 expfac=expfac+Ax(k,j,iii)*z(k)
5936 C As in the case of ebend, we want to avoid underflows in exponentiation and
5937 C subsequent NaNs and INFs in energy calculation.
5938 C Find the largest exponent
5942 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5946 cd print *,'it=',it,' emin=',emin
5948 C Compute the contribution to SC energy and derivatives
5952 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5953 cd print *,'j=',j,' expfac=',expfac
5954 escloc_i=escloc_i+expfac
5956 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5960 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5961 & +gaussc(k,2,j,it))*expfac
5968 dersc(1)=dersc(1)/cos(theti)**2
5969 ddersc(1)=ddersc(1)/cos(theti)**2
5972 escloci=-(dlog(escloc_i)-emin)
5974 dersc(j)=dersc(j)/escloc_i
5978 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5983 C------------------------------------------------------------------------------
5984 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5985 implicit real*8 (a-h,o-z)
5986 include 'DIMENSIONS'
5987 include 'COMMON.GEO'
5988 include 'COMMON.LOCAL'
5989 include 'COMMON.IOUNITS'
5990 common /sccalc/ time11,time12,time112,theti,it,nlobit
5991 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5992 double precision contr(maxlob)
6003 z(k)=x(k)-censc(k,j,it)
6009 Axk=Axk+gaussc(l,k,j,it)*z(l)
6015 expfac=expfac+Ax(k,j)*z(k)
6020 C As in the case of ebend, we want to avoid underflows in exponentiation and
6021 C subsequent NaNs and INFs in energy calculation.
6022 C Find the largest exponent
6025 if (emin.gt.contr(j)) emin=contr(j)
6029 C Compute the contribution to SC energy and derivatives
6033 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6034 escloc_i=escloc_i+expfac
6036 dersc(k)=dersc(k)+Ax(k,j)*expfac
6038 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6039 & +gaussc(1,2,j,it))*expfac
6043 dersc(1)=dersc(1)/cos(theti)**2
6044 dersc12=dersc12/cos(theti)**2
6045 escloci=-(dlog(escloc_i)-emin)
6047 dersc(j)=dersc(j)/escloc_i
6049 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6053 c----------------------------------------------------------------------------------
6054 subroutine esc(escloc)
6055 C Calculate the local energy of a side chain and its derivatives in the
6056 C corresponding virtual-bond valence angles THETA and the spherical angles
6057 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6058 C added by Urszula Kozlowska. 07/11/2007
6060 implicit real*8 (a-h,o-z)
6061 include 'DIMENSIONS'
6062 include 'DIMENSIONS.ZSCOPT'
6063 include 'COMMON.GEO'
6064 include 'COMMON.LOCAL'
6065 include 'COMMON.VAR'
6066 include 'COMMON.SCROT'
6067 include 'COMMON.INTERACT'
6068 include 'COMMON.DERIV'
6069 include 'COMMON.CHAIN'
6070 include 'COMMON.IOUNITS'
6071 include 'COMMON.NAMES'
6072 include 'COMMON.FFIELD'
6073 include 'COMMON.CONTROL'
6074 include 'COMMON.VECTORS'
6075 double precision x_prime(3),y_prime(3),z_prime(3)
6076 & , sumene,dsc_i,dp2_i,x(65),
6077 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6078 & de_dxx,de_dyy,de_dzz,de_dt
6079 double precision s1_t,s1_6_t,s2_t,s2_6_t
6081 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6082 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6083 & dt_dCi(3),dt_dCi1(3)
6084 common /sccalc/ time11,time12,time112,theti,it,nlobit
6087 do i=loc_start,loc_end
6088 if (itype(i).eq.ntyp1) cycle
6089 costtab(i+1) =dcos(theta(i+1))
6090 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6091 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6092 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6093 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6094 cosfac=dsqrt(cosfac2)
6095 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6096 sinfac=dsqrt(sinfac2)
6098 if (it.eq.10) goto 1
6100 C Compute the axes of tghe local cartesian coordinates system; store in
6101 c x_prime, y_prime and z_prime
6108 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6109 C & dc_norm(3,i+nres)
6111 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6112 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6115 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6118 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6119 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6120 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6121 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6122 c & " xy",scalar(x_prime(1),y_prime(1)),
6123 c & " xz",scalar(x_prime(1),z_prime(1)),
6124 c & " yy",scalar(y_prime(1),y_prime(1)),
6125 c & " yz",scalar(y_prime(1),z_prime(1)),
6126 c & " zz",scalar(z_prime(1),z_prime(1))
6128 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6129 C to local coordinate system. Store in xx, yy, zz.
6135 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6136 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6137 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6144 C Compute the energy of the ith side cbain
6146 c write (2,*) "xx",xx," yy",yy," zz",zz
6149 x(j) = sc_parmin(j,it)
6152 Cc diagnostics - remove later
6154 yy1 = dsin(alph(2))*dcos(omeg(2))
6155 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
6156 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6157 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6159 C," --- ", xx_w,yy_w,zz_w
6162 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6163 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6165 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6166 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6168 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6169 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6170 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6171 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6172 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6174 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6175 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6176 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6177 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6178 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6180 dsc_i = 0.743d0+x(61)
6182 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6183 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6184 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6185 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6186 s1=(1+x(63))/(0.1d0 + dscp1)
6187 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6188 s2=(1+x(65))/(0.1d0 + dscp2)
6189 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6190 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6191 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6192 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6194 c & dscp1,dscp2,sumene
6195 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6196 escloc = escloc + sumene
6197 c write (2,*) "escloc",escloc
6198 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
6200 if (.not. calc_grad) goto 1
6203 C This section to check the numerical derivatives of the energy of ith side
6204 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6205 C #define DEBUG in the code to turn it on.
6207 write (2,*) "sumene =",sumene
6211 write (2,*) xx,yy,zz
6212 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6213 de_dxx_num=(sumenep-sumene)/aincr
6215 write (2,*) "xx+ sumene from enesc=",sumenep
6218 write (2,*) xx,yy,zz
6219 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6220 de_dyy_num=(sumenep-sumene)/aincr
6222 write (2,*) "yy+ sumene from enesc=",sumenep
6225 write (2,*) xx,yy,zz
6226 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6227 de_dzz_num=(sumenep-sumene)/aincr
6229 write (2,*) "zz+ sumene from enesc=",sumenep
6230 costsave=cost2tab(i+1)
6231 sintsave=sint2tab(i+1)
6232 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6233 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6234 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6235 de_dt_num=(sumenep-sumene)/aincr
6236 write (2,*) " t+ sumene from enesc=",sumenep
6237 cost2tab(i+1)=costsave
6238 sint2tab(i+1)=sintsave
6239 C End of diagnostics section.
6242 C Compute the gradient of esc
6244 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6245 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6246 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6247 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6248 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6249 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6250 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6251 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6252 pom1=(sumene3*sint2tab(i+1)+sumene1)
6253 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6254 pom2=(sumene4*cost2tab(i+1)+sumene2)
6255 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6256 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6257 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6258 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6260 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6261 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6262 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6264 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6265 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6266 & +(pom1+pom2)*pom_dx
6268 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
6271 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6272 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6273 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6275 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6276 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6277 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6278 & +x(59)*zz**2 +x(60)*xx*zz
6279 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6280 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6281 & +(pom1-pom2)*pom_dy
6283 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
6286 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6287 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6288 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6289 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6290 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6291 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6292 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6293 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6295 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
6298 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6299 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6300 & +pom1*pom_dt1+pom2*pom_dt2
6302 write(2,*), "de_dt = ", de_dt,de_dt_num
6306 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6307 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6308 cosfac2xx=cosfac2*xx
6309 sinfac2yy=sinfac2*yy
6311 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6313 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6315 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6316 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6317 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6318 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6319 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6320 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6321 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6322 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6323 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6324 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6328 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6329 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6330 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6331 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6334 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6335 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6336 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
6338 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6339 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6343 dXX_Ctab(k,i)=dXX_Ci(k)
6344 dXX_C1tab(k,i)=dXX_Ci1(k)
6345 dYY_Ctab(k,i)=dYY_Ci(k)
6346 dYY_C1tab(k,i)=dYY_Ci1(k)
6347 dZZ_Ctab(k,i)=dZZ_Ci(k)
6348 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6349 dXX_XYZtab(k,i)=dXX_XYZ(k)
6350 dYY_XYZtab(k,i)=dYY_XYZ(k)
6351 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6355 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6356 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6357 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6358 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6359 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6361 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6362 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6363 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6364 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6365 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6366 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6367 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6368 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6370 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6371 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6373 C to check gradient call subroutine check_grad
6380 c------------------------------------------------------------------------------
6381 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6383 C This procedure calculates two-body contact function g(rij) and its derivative:
6386 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6389 C where x=(rij-r0ij)/delta
6391 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6394 double precision rij,r0ij,eps0ij,fcont,fprimcont
6395 double precision x,x2,x4,delta
6399 if (x.lt.-1.0D0) then
6402 else if (x.le.1.0D0) then
6405 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6406 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6413 c------------------------------------------------------------------------------
6414 subroutine splinthet(theti,delta,ss,ssder)
6415 implicit real*8 (a-h,o-z)
6416 include 'DIMENSIONS'
6417 include 'DIMENSIONS.ZSCOPT'
6418 include 'COMMON.VAR'
6419 include 'COMMON.GEO'
6422 if (theti.gt.pipol) then
6423 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6425 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6430 c------------------------------------------------------------------------------
6431 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6433 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6434 double precision ksi,ksi2,ksi3,a1,a2,a3
6435 a1=fprim0*delta/(f1-f0)
6441 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6442 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6445 c------------------------------------------------------------------------------
6446 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6448 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6449 double precision ksi,ksi2,ksi3,a1,a2,a3
6454 a2=3*(f1x-f0x)-2*fprim0x*delta
6455 a3=fprim0x*delta-2*(f1x-f0x)
6456 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6459 C-----------------------------------------------------------------------------
6461 C-----------------------------------------------------------------------------
6462 subroutine etor(etors,fact)
6463 implicit real*8 (a-h,o-z)
6464 include 'DIMENSIONS'
6465 include 'DIMENSIONS.ZSCOPT'
6466 include 'COMMON.VAR'
6467 include 'COMMON.GEO'
6468 include 'COMMON.LOCAL'
6469 include 'COMMON.TORSION'
6470 include 'COMMON.INTERACT'
6471 include 'COMMON.DERIV'
6472 include 'COMMON.CHAIN'
6473 include 'COMMON.NAMES'
6474 include 'COMMON.IOUNITS'
6475 include 'COMMON.FFIELD'
6476 include 'COMMON.TORCNSTR'
6478 C Set lprn=.true. for debugging
6482 do i=iphi_start,iphi_end
6483 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6484 & .or. itype(i).eq.ntyp1) cycle
6485 itori=itortyp(itype(i-2))
6486 itori1=itortyp(itype(i-1))
6489 C Proline-Proline pair is a special case...
6490 if (itori.eq.3 .and. itori1.eq.3) then
6491 if (phii.gt.-dwapi3) then
6493 fac=1.0D0/(1.0D0-cosphi)
6494 etorsi=v1(1,3,3)*fac
6495 etorsi=etorsi+etorsi
6496 etors=etors+etorsi-v1(1,3,3)
6497 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6500 v1ij=v1(j+1,itori,itori1)
6501 v2ij=v2(j+1,itori,itori1)
6504 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6505 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6509 v1ij=v1(j,itori,itori1)
6510 v2ij=v2(j,itori,itori1)
6513 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6514 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6518 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6519 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6520 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6521 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6522 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6526 c------------------------------------------------------------------------------
6528 subroutine etor(etors,fact)
6529 implicit real*8 (a-h,o-z)
6530 include 'DIMENSIONS'
6531 include 'DIMENSIONS.ZSCOPT'
6532 include 'COMMON.VAR'
6533 include 'COMMON.GEO'
6534 include 'COMMON.LOCAL'
6535 include 'COMMON.TORSION'
6536 include 'COMMON.INTERACT'
6537 include 'COMMON.DERIV'
6538 include 'COMMON.CHAIN'
6539 include 'COMMON.NAMES'
6540 include 'COMMON.IOUNITS'
6541 include 'COMMON.FFIELD'
6542 include 'COMMON.TORCNSTR'
6544 C Set lprn=.true. for debugging
6548 do i=iphi_start,iphi_end
6550 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6551 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6552 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
6553 C & .or. itype(i).eq.ntyp1) cycle
6554 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6555 if (iabs(itype(i)).eq.20) then
6560 itori=itortyp(itype(i-2))
6561 itori1=itortyp(itype(i-1))
6564 C Regular cosine and sine terms
6565 do j=1,nterm(itori,itori1,iblock)
6566 v1ij=v1(j,itori,itori1,iblock)
6567 v2ij=v2(j,itori,itori1,iblock)
6570 etors=etors+v1ij*cosphi+v2ij*sinphi
6571 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6575 C E = SUM ----------------------------------- - v1
6576 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6578 cosphi=dcos(0.5d0*phii)
6579 sinphi=dsin(0.5d0*phii)
6580 do j=1,nlor(itori,itori1,iblock)
6581 vl1ij=vlor1(j,itori,itori1)
6582 vl2ij=vlor2(j,itori,itori1)
6583 vl3ij=vlor3(j,itori,itori1)
6584 pom=vl2ij*cosphi+vl3ij*sinphi
6585 pom1=1.0d0/(pom*pom+1.0d0)
6586 etors=etors+vl1ij*pom1
6587 c if (energy_dec) etors_ii=etors_ii+
6590 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6592 C Subtract the constant term
6593 etors=etors-v0(itori,itori1,iblock)
6595 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6596 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6597 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
6598 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6599 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6604 c----------------------------------------------------------------------------
6605 subroutine etor_d(etors_d,fact2)
6606 C 6/23/01 Compute double torsional energy
6607 implicit real*8 (a-h,o-z)
6608 include 'DIMENSIONS'
6609 include 'DIMENSIONS.ZSCOPT'
6610 include 'COMMON.VAR'
6611 include 'COMMON.GEO'
6612 include 'COMMON.LOCAL'
6613 include 'COMMON.TORSION'
6614 include 'COMMON.INTERACT'
6615 include 'COMMON.DERIV'
6616 include 'COMMON.CHAIN'
6617 include 'COMMON.NAMES'
6618 include 'COMMON.IOUNITS'
6619 include 'COMMON.FFIELD'
6620 include 'COMMON.TORCNSTR'
6622 C Set lprn=.true. for debugging
6626 do i=iphi_start,iphi_end-1
6628 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6629 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
6630 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6631 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6632 & (itype(i+1).eq.ntyp1)) cycle
6633 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6635 itori=itortyp(itype(i-2))
6636 itori1=itortyp(itype(i-1))
6637 itori2=itortyp(itype(i))
6643 if (iabs(itype(i+1)).eq.20) iblock=2
6644 C Regular cosine and sine terms
6645 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6646 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6647 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6648 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6649 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6650 cosphi1=dcos(j*phii)
6651 sinphi1=dsin(j*phii)
6652 cosphi2=dcos(j*phii1)
6653 sinphi2=dsin(j*phii1)
6654 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6655 & v2cij*cosphi2+v2sij*sinphi2
6656 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6657 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6659 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6661 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6662 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6663 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6664 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6665 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6666 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6667 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6668 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6669 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6670 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6671 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6672 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6673 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6674 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6677 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6678 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6684 c---------------------------------------------------------------------------
6685 C The rigorous attempt to derive energy function
6686 subroutine etor_kcc(etors,fact)
6687 implicit real*8 (a-h,o-z)
6688 include 'DIMENSIONS'
6689 include 'DIMENSIONS.ZSCOPT'
6690 include 'COMMON.VAR'
6691 include 'COMMON.GEO'
6692 include 'COMMON.LOCAL'
6693 include 'COMMON.TORSION'
6694 include 'COMMON.INTERACT'
6695 include 'COMMON.DERIV'
6696 include 'COMMON.CHAIN'
6697 include 'COMMON.NAMES'
6698 include 'COMMON.IOUNITS'
6699 include 'COMMON.FFIELD'
6700 include 'COMMON.TORCNSTR'
6701 include 'COMMON.CONTROL'
6702 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
6704 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
6705 C Set lprn=.true. for debugging
6708 C print *,"wchodze kcc"
6709 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
6711 do i=iphi_start,iphi_end
6712 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6713 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6714 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6715 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6716 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6717 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6718 itori=itortyp(itype(i-2))
6719 itori1=itortyp(itype(i-1))
6724 C to avoid multiple devision by 2
6725 c theti22=0.5d0*theta(i)
6726 C theta 12 is the theta_1 /2
6727 C theta 22 is theta_2 /2
6728 c theti12=0.5d0*theta(i-1)
6729 C and appropriate sinus function
6730 sinthet1=dsin(theta(i-1))
6731 sinthet2=dsin(theta(i))
6732 costhet1=dcos(theta(i-1))
6733 costhet2=dcos(theta(i))
6734 C to speed up lets store its mutliplication
6735 sint1t2=sinthet2*sinthet1
6737 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
6738 C +d_n*sin(n*gamma)) *
6739 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
6740 C we have two sum 1) Non-Chebyshev which is with n and gamma
6741 nval=nterm_kcc_Tb(itori,itori1)
6747 c1(j)=c1(j-1)*costhet1
6748 c2(j)=c2(j-1)*costhet2
6751 do j=1,nterm_kcc(itori,itori1)
6755 sint1t2n=sint1t2n*sint1t2
6761 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6762 gradvalct1=gradvalct1+
6763 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6764 gradvalct2=gradvalct2+
6765 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6768 gradvalct1=-gradvalct1*sinthet1
6769 gradvalct2=-gradvalct2*sinthet2
6775 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
6776 gradvalst1=gradvalst1+
6777 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
6778 gradvalst2=gradvalst2+
6779 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
6782 gradvalst1=-gradvalst1*sinthet1
6783 gradvalst2=-gradvalst2*sinthet2
6784 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
6785 C glocig is the gradient local i site in gamma
6786 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
6787 C now gradient over theta_1
6788 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
6789 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
6790 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
6791 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
6794 C derivative over gamma
6795 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
6796 C derivative over theta1
6797 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
6798 C now derivative over theta2
6799 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
6801 write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
6802 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
6803 write (iout,*) "c1",(c1(k),k=0,nval),
6804 & " c2",(c2(k),k=0,nval)
6805 write (iout,*) "sumvalc",sumvalc," sumvals",sumvals
6810 c---------------------------------------------------------------------------------------------
6811 subroutine etor_constr(edihcnstr)
6812 implicit real*8 (a-h,o-z)
6813 include 'DIMENSIONS'
6814 include 'DIMENSIONS.ZSCOPT'
6815 include 'COMMON.VAR'
6816 include 'COMMON.GEO'
6817 include 'COMMON.LOCAL'
6818 include 'COMMON.TORSION'
6819 include 'COMMON.INTERACT'
6820 include 'COMMON.DERIV'
6821 include 'COMMON.CHAIN'
6822 include 'COMMON.NAMES'
6823 include 'COMMON.IOUNITS'
6824 include 'COMMON.FFIELD'
6825 include 'COMMON.TORCNSTR'
6826 include 'COMMON.CONTROL'
6827 ! 6/20/98 - dihedral angle constraints
6829 c do i=1,ndih_constr
6830 c write (iout,*) "idihconstr_start",idihconstr_start,
6831 c & " idihconstr_end",idihconstr_end
6833 if (raw_psipred) then
6834 do i=idihconstr_start,idihconstr_end
6835 itori=idih_constr(i)
6837 gaudih_i=vpsipred(1,i)
6841 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
6842 dexpcos_i=dexp(-cos_i*cos_i)
6843 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
6844 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
6845 & *cos_i*dexpcos_i/s**2
6847 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
6848 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
6850 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
6851 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
6852 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
6853 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
6854 & -wdihc*dlog(gaudih_i)
6858 do i=idihconstr_start,idihconstr_end
6859 itori=idih_constr(i)
6861 difi=pinorm(phii-phi0(i))
6862 if (difi.gt.drange(i)) then
6864 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6865 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6866 else if (difi.lt.-drange(i)) then
6868 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6869 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6877 c write (iout,*) "ETOR_CONSTR",edihcnstr
6880 c----------------------------------------------------------------------------
6881 C The rigorous attempt to derive energy function
6882 subroutine ebend_kcc(etheta)
6884 implicit real*8 (a-h,o-z)
6885 include 'DIMENSIONS'
6886 include 'DIMENSIONS.ZSCOPT'
6887 include 'COMMON.VAR'
6888 include 'COMMON.GEO'
6889 include 'COMMON.LOCAL'
6890 include 'COMMON.TORSION'
6891 include 'COMMON.INTERACT'
6892 include 'COMMON.DERIV'
6893 include 'COMMON.CHAIN'
6894 include 'COMMON.NAMES'
6895 include 'COMMON.IOUNITS'
6896 include 'COMMON.FFIELD'
6897 include 'COMMON.TORCNSTR'
6898 include 'COMMON.CONTROL'
6900 double precision thybt1(maxang_kcc)
6901 C Set lprn=.true. for debugging
6904 C print *,"wchodze kcc"
6905 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6907 do i=ithet_start,ithet_end
6908 c print *,i,itype(i-1),itype(i),itype(i-2)
6909 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6910 & .or.itype(i).eq.ntyp1) cycle
6911 iti=iabs(itortyp(itype(i-1)))
6912 sinthet=dsin(theta(i))
6913 costhet=dcos(theta(i))
6914 do j=1,nbend_kcc_Tb(iti)
6915 thybt1(j)=v1bend_chyb(j,iti)
6917 sumth1thyb=v1bend_chyb(0,iti)+
6918 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6919 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6921 ihelp=nbend_kcc_Tb(iti)-1
6922 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6923 etheta=etheta+sumth1thyb
6924 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6925 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6929 c-------------------------------------------------------------------------------------
6930 subroutine etheta_constr(ethetacnstr)
6932 implicit real*8 (a-h,o-z)
6933 include 'DIMENSIONS'
6934 include 'DIMENSIONS.ZSCOPT'
6935 include 'COMMON.VAR'
6936 include 'COMMON.GEO'
6937 include 'COMMON.LOCAL'
6938 include 'COMMON.TORSION'
6939 include 'COMMON.INTERACT'
6940 include 'COMMON.DERIV'
6941 include 'COMMON.CHAIN'
6942 include 'COMMON.NAMES'
6943 include 'COMMON.IOUNITS'
6944 include 'COMMON.FFIELD'
6945 include 'COMMON.TORCNSTR'
6946 include 'COMMON.CONTROL'
6948 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6949 do i=ithetaconstr_start,ithetaconstr_end
6950 itheta=itheta_constr(i)
6951 thetiii=theta(itheta)
6952 difi=pinorm(thetiii-theta_constr0(i))
6953 if (difi.gt.theta_drange(i)) then
6954 difi=difi-theta_drange(i)
6955 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6956 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6957 & +for_thet_constr(i)*difi**3
6958 else if (difi.lt.-drange(i)) then
6960 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6961 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6962 & +for_thet_constr(i)*difi**3
6966 if (energy_dec) then
6967 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6968 & i,itheta,rad2deg*thetiii,
6969 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6970 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6971 & gloc(itheta+nphi-2,icg)
6976 c------------------------------------------------------------------------------
6977 c------------------------------------------------------------------------------
6978 subroutine eback_sc_corr(esccor)
6979 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6980 c conformational states; temporarily implemented as differences
6981 c between UNRES torsional potentials (dependent on three types of
6982 c residues) and the torsional potentials dependent on all 20 types
6983 c of residues computed from AM1 energy surfaces of terminally-blocked
6984 c amino-acid residues.
6985 implicit real*8 (a-h,o-z)
6986 include 'DIMENSIONS'
6987 include 'DIMENSIONS.ZSCOPT'
6988 include 'COMMON.VAR'
6989 include 'COMMON.GEO'
6990 include 'COMMON.LOCAL'
6991 include 'COMMON.TORSION'
6992 include 'COMMON.SCCOR'
6993 include 'COMMON.INTERACT'
6994 include 'COMMON.DERIV'
6995 include 'COMMON.CHAIN'
6996 include 'COMMON.NAMES'
6997 include 'COMMON.IOUNITS'
6998 include 'COMMON.FFIELD'
6999 include 'COMMON.CONTROL'
7001 C Set lprn=.true. for debugging
7004 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
7006 do i=itau_start,itau_end
7007 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7009 isccori=isccortyp(itype(i-2))
7010 isccori1=isccortyp(itype(i-1))
7012 do intertyp=1,3 !intertyp
7013 cc Added 09 May 2012 (Adasko)
7014 cc Intertyp means interaction type of backbone mainchain correlation:
7015 c 1 = SC...Ca...Ca...Ca
7016 c 2 = Ca...Ca...Ca...SC
7017 c 3 = SC...Ca...Ca...SCi
7019 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7020 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7021 & (itype(i-1).eq.ntyp1)))
7022 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7023 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7024 & .or.(itype(i).eq.ntyp1)))
7025 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7026 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7027 & (itype(i-3).eq.ntyp1)))) cycle
7028 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7029 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7031 do j=1,nterm_sccor(isccori,isccori1)
7032 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7033 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7034 cosphi=dcos(j*tauangle(intertyp,i))
7035 sinphi=dsin(j*tauangle(intertyp,i))
7036 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7037 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7039 C write (iout,*)"EBACK_SC_COR",esccor,i
7040 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
7041 c & nterm_sccor(isccori,isccori1),isccori,isccori1
7042 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7044 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7045 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7046 & (v1sccor(j,1,itori,itori1),j=1,6)
7047 & ,(v2sccor(j,1,itori,itori1),j=1,6)
7048 c gsccor_loc(i-3)=gloci
7054 c------------------------------------------------------------------------------
7055 subroutine multibody(ecorr)
7056 C This subroutine calculates multi-body contributions to energy following
7057 C the idea of Skolnick et al. If side chains I and J make a contact and
7058 C at the same time side chains I+1 and J+1 make a contact, an extra
7059 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7060 implicit real*8 (a-h,o-z)
7061 include 'DIMENSIONS'
7062 include 'COMMON.IOUNITS'
7063 include 'COMMON.DERIV'
7064 include 'COMMON.INTERACT'
7065 include 'COMMON.CONTACTS'
7066 include 'COMMON.CONTMAT'
7067 include 'COMMON.CORRMAT'
7068 double precision gx(3),gx1(3)
7071 C Set lprn=.true. for debugging
7075 write (iout,'(a)') 'Contact function values:'
7077 write (iout,'(i2,20(1x,i2,f10.5))')
7078 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7093 num_conti=num_cont(i)
7094 num_conti1=num_cont(i1)
7099 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7100 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7101 cd & ' ishift=',ishift
7102 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7103 C The system gains extra energy.
7104 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7105 endif ! j1==j+-ishift
7114 c------------------------------------------------------------------------------
7115 double precision function esccorr(i,j,k,l,jj,kk)
7116 implicit real*8 (a-h,o-z)
7117 include 'DIMENSIONS'
7118 include 'COMMON.IOUNITS'
7119 include 'COMMON.DERIV'
7120 include 'COMMON.INTERACT'
7121 include 'COMMON.CONTACTS'
7122 include 'COMMON.CONTMAT'
7123 include 'COMMON.CORRMAT'
7124 double precision gx(3),gx1(3)
7129 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7130 C Calculate the multi-body contribution to energy.
7131 C Calculate multi-body contributions to the gradient.
7132 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7133 cd & k,l,(gacont(m,kk,k),m=1,3)
7135 gx(m) =ekl*gacont(m,jj,i)
7136 gx1(m)=eij*gacont(m,kk,k)
7137 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7138 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7139 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7140 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7144 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7149 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7155 c------------------------------------------------------------------------------
7156 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7157 C This subroutine calculates multi-body contributions to hydrogen-bonding
7158 implicit real*8 (a-h,o-z)
7159 include 'DIMENSIONS'
7160 include 'DIMENSIONS.ZSCOPT'
7161 include 'COMMON.IOUNITS'
7162 include 'COMMON.FFIELD'
7163 include 'COMMON.DERIV'
7164 include 'COMMON.INTERACT'
7165 include 'COMMON.CONTACTS'
7166 include 'COMMON.CONTMAT'
7167 include 'COMMON.CORRMAT'
7168 double precision gx(3),gx1(3)
7171 C Set lprn=.true. for debugging
7174 write (iout,'(a)') 'Contact function values:'
7176 write (iout,'(2i3,50(1x,i2,f5.2))')
7177 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7178 & j=1,num_cont_hb(i))
7182 C Remove the loop below after debugging !!!
7189 C Calculate the local-electrostatic correlation terms
7190 do i=iatel_s,iatel_e+1
7192 num_conti=num_cont_hb(i)
7193 num_conti1=num_cont_hb(i+1)
7198 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7199 c & ' jj=',jj,' kk=',kk
7200 if (j1.eq.j+1 .or. j1.eq.j-1) then
7201 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7202 C The system gains extra energy.
7203 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7205 else if (j1.eq.j) then
7206 C Contacts I-J and I-(J+1) occur simultaneously.
7207 C The system loses extra energy.
7208 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7213 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7214 c & ' jj=',jj,' kk=',kk
7216 C Contacts I-J and (I+1)-J occur simultaneously.
7217 C The system loses extra energy.
7218 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7225 c------------------------------------------------------------------------------
7226 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7228 C This subroutine calculates multi-body contributions to hydrogen-bonding
7229 implicit real*8 (a-h,o-z)
7230 include 'DIMENSIONS'
7231 include 'DIMENSIONS.ZSCOPT'
7232 include 'COMMON.IOUNITS'
7236 include 'COMMON.FFIELD'
7237 include 'COMMON.DERIV'
7238 include 'COMMON.LOCAL'
7239 include 'COMMON.INTERACT'
7240 include 'COMMON.CONTACTS'
7241 include 'COMMON.CONTMAT'
7242 include 'COMMON.CORRMAT'
7243 include 'COMMON.CHAIN'
7244 include 'COMMON.CONTROL'
7245 include 'COMMON.SHIELD'
7246 double precision gx(3),gx1(3)
7247 integer num_cont_hb_old(maxres)
7249 double precision eello4,eello5,eelo6,eello_turn6
7250 external eello4,eello5,eello6,eello_turn6
7251 C Set lprn=.true. for debugging
7255 write (iout,'(a)') 'Contact function values:'
7257 write (iout,'(2i3,50(1x,i2,5f6.3))')
7258 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7259 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7265 C Remove the loop below after debugging !!!
7272 C Calculate the dipole-dipole interaction energies
7273 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7274 do i=iatel_s,iatel_e+1
7275 num_conti=num_cont_hb(i)
7284 C Calculate the local-electrostatic correlation terms
7285 c write (iout,*) "gradcorr5 in eello5 before loop"
7287 c write (iout,'(i5,3f10.5)')
7288 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7290 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7291 c write (iout,*) "corr loop i",i
7293 num_conti=num_cont_hb(i)
7294 num_conti1=num_cont_hb(i+1)
7301 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7302 c & ' jj=',jj,' kk=',kk
7303 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7304 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7305 & .or. j.lt.0 .and. j1.gt.0) .and.
7306 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7307 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7308 C The system gains extra energy.
7310 sqd1=dsqrt(d_cont(jj,i))
7311 sqd2=dsqrt(d_cont(kk,i1))
7312 sred_geom = sqd1*sqd2
7313 IF (sred_geom.lt.cutoff_corr) THEN
7314 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7316 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7317 cd & ' jj=',jj,' kk=',kk
7318 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7319 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7321 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7322 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7325 cd write (iout,*) 'sred_geom=',sred_geom,
7326 cd & ' ekont=',ekont,' fprim=',fprimcont,
7327 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7328 cd write (iout,*) "g_contij",g_contij
7329 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7330 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7331 call calc_eello(i,jp,i+1,jp1,jj,kk)
7332 if (wcorr4.gt.0.0d0)
7333 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7334 CC & *fac_shield(i)**2*fac_shield(j)**2
7335 if (energy_dec.and.wcorr4.gt.0.0d0)
7336 1 write (iout,'(a6,4i5,0pf7.3)')
7337 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7338 c write (iout,*) "gradcorr5 before eello5"
7340 c write (iout,'(i5,3f10.5)')
7341 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7343 if (wcorr5.gt.0.0d0)
7344 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7345 c write (iout,*) "gradcorr5 after eello5"
7347 c write (iout,'(i5,3f10.5)')
7348 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7350 if (energy_dec.and.wcorr5.gt.0.0d0)
7351 1 write (iout,'(a6,4i5,0pf7.3)')
7352 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7353 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7354 cd write(2,*)'ijkl',i,jp,i+1,jp1
7355 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7356 & .or. wturn6.eq.0.0d0))then
7357 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7358 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7359 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7360 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7361 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7362 cd & 'ecorr6=',ecorr6
7363 cd write (iout,'(4e15.5)') sred_geom,
7364 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7365 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7366 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7367 else if (wturn6.gt.0.0d0
7368 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7369 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7370 eturn6=eturn6+eello_turn6(i,jj,kk)
7371 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7372 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7373 cd write (2,*) 'multibody_eello:eturn6',eturn6
7382 num_cont_hb(i)=num_cont_hb_old(i)
7384 c write (iout,*) "gradcorr5 in eello5"
7386 c write (iout,'(i5,3f10.5)')
7387 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7391 c------------------------------------------------------------------------------
7392 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7393 implicit real*8 (a-h,o-z)
7394 include 'DIMENSIONS'
7395 include 'DIMENSIONS.ZSCOPT'
7396 include 'COMMON.IOUNITS'
7397 include 'COMMON.DERIV'
7398 include 'COMMON.INTERACT'
7399 include 'COMMON.CONTACTS'
7400 include 'COMMON.CONTMAT'
7401 include 'COMMON.CORRMAT'
7402 include 'COMMON.SHIELD'
7403 include 'COMMON.CONTROL'
7404 double precision gx(3),gx1(3)
7407 C print *,"wchodze",fac_shield(i),shield_mode
7415 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7417 C & fac_shield(i)**2*fac_shield(j)**2
7418 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7419 C Following 4 lines for diagnostics.
7424 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7425 c & 'Contacts ',i,j,
7426 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7427 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7429 C Calculate the multi-body contribution to energy.
7430 C ecorr=ecorr+ekont*ees
7431 C Calculate multi-body contributions to the gradient.
7432 coeffpees0pij=coeffp*ees0pij
7433 coeffmees0mij=coeffm*ees0mij
7434 coeffpees0pkl=coeffp*ees0pkl
7435 coeffmees0mkl=coeffm*ees0mkl
7437 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7438 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7439 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7440 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7441 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7442 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7443 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7444 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7445 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7446 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7447 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7448 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7449 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7450 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7451 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7452 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7453 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7454 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7455 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7456 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7457 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7458 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7459 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7460 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7461 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7466 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7467 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7468 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7469 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7474 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7475 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7476 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7477 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7480 c write (iout,*) "ehbcorr",ekont*ees
7481 C print *,ekont,ees,i,k
7483 C now gradient over shielding
7485 if (shield_mode.gt.0) then
7488 C print *,i,j,fac_shield(i),fac_shield(j),
7489 C &fac_shield(k),fac_shield(l)
7490 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
7491 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7492 do ilist=1,ishield_list(i)
7493 iresshield=shield_list(ilist,i)
7495 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7497 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7499 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7500 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7504 do ilist=1,ishield_list(j)
7505 iresshield=shield_list(ilist,j)
7507 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7509 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7511 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7512 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7517 do ilist=1,ishield_list(k)
7518 iresshield=shield_list(ilist,k)
7520 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7522 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7524 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7525 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7529 do ilist=1,ishield_list(l)
7530 iresshield=shield_list(ilist,l)
7532 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7534 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
7536 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7537 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
7541 C print *,gshieldx(m,iresshield)
7543 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
7544 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7545 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
7546 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7547 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
7548 & grad_shield(m,i)*ehbcorr/fac_shield(i)
7549 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
7550 & grad_shield(m,j)*ehbcorr/fac_shield(j)
7552 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
7553 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7554 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
7555 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7556 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
7557 & grad_shield(m,k)*ehbcorr/fac_shield(k)
7558 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
7559 & grad_shield(m,l)*ehbcorr/fac_shield(l)
7567 C---------------------------------------------------------------------------
7568 subroutine dipole(i,j,jj)
7569 implicit real*8 (a-h,o-z)
7570 include 'DIMENSIONS'
7571 include 'DIMENSIONS.ZSCOPT'
7572 include 'COMMON.IOUNITS'
7573 include 'COMMON.CHAIN'
7574 include 'COMMON.FFIELD'
7575 include 'COMMON.DERIV'
7576 include 'COMMON.INTERACT'
7577 include 'COMMON.CONTACTS'
7578 include 'COMMON.CONTMAT'
7579 include 'COMMON.CORRMAT'
7580 include 'COMMON.TORSION'
7581 include 'COMMON.VAR'
7582 include 'COMMON.GEO'
7583 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7585 iti1 = itortyp(itype(i+1))
7586 if (j.lt.nres-1) then
7587 itj1 = itype2loc(itype(j+1))
7592 dipi(iii,1)=Ub2(iii,i)
7593 dipderi(iii)=Ub2der(iii,i)
7594 dipi(iii,2)=b1(iii,i+1)
7595 dipj(iii,1)=Ub2(iii,j)
7596 dipderj(iii)=Ub2der(iii,j)
7597 dipj(iii,2)=b1(iii,j+1)
7601 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7604 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7611 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7615 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7620 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7621 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7623 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7625 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7627 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7632 C---------------------------------------------------------------------------
7633 subroutine calc_eello(i,j,k,l,jj,kk)
7635 C This subroutine computes matrices and vectors needed to calculate
7636 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7638 implicit real*8 (a-h,o-z)
7639 include 'DIMENSIONS'
7640 include 'DIMENSIONS.ZSCOPT'
7641 include 'COMMON.IOUNITS'
7642 include 'COMMON.CHAIN'
7643 include 'COMMON.DERIV'
7644 include 'COMMON.INTERACT'
7645 include 'COMMON.CONTACTS'
7646 include 'COMMON.CONTMAT'
7647 include 'COMMON.CORRMAT'
7648 include 'COMMON.TORSION'
7649 include 'COMMON.VAR'
7650 include 'COMMON.GEO'
7651 include 'COMMON.FFIELD'
7652 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7653 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7656 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7657 cd & ' jj=',jj,' kk=',kk
7658 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7659 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7660 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7663 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7664 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7667 call transpose2(aa1(1,1),aa1t(1,1))
7668 call transpose2(aa2(1,1),aa2t(1,1))
7671 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7672 & aa1tder(1,1,lll,kkk))
7673 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7674 & aa2tder(1,1,lll,kkk))
7678 C parallel orientation of the two CA-CA-CA frames.
7680 iti=itype2loc(itype(i))
7684 itk1=itype2loc(itype(k+1))
7685 itj=itype2loc(itype(j))
7686 if (l.lt.nres-1) then
7687 itl1=itype2loc(itype(l+1))
7691 C A1 kernel(j+1) A2T
7693 cd write (iout,'(3f10.5,5x,3f10.5)')
7694 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7696 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7697 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7698 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7699 C Following matrices are needed only for 6-th order cumulants
7700 IF (wcorr6.gt.0.0d0) THEN
7701 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7702 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7703 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7704 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7705 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7706 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7707 & ADtEAderx(1,1,1,1,1,1))
7709 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7710 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7711 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7712 & ADtEA1derx(1,1,1,1,1,1))
7714 C End 6-th order cumulants
7717 cd write (2,*) 'In calc_eello6'
7719 cd write (2,*) 'iii=',iii
7721 cd write (2,*) 'kkk=',kkk
7723 cd write (2,'(3(2f10.5),5x)')
7724 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7729 call transpose2(EUgder(1,1,k),auxmat(1,1))
7730 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7731 call transpose2(EUg(1,1,k),auxmat(1,1))
7732 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7733 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7737 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7738 & EAEAderx(1,1,lll,kkk,iii,1))
7742 C A1T kernel(i+1) A2
7743 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7744 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7745 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7746 C Following matrices are needed only for 6-th order cumulants
7747 IF (wcorr6.gt.0.0d0) THEN
7748 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7749 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7750 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7751 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7752 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7753 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7754 & ADtEAderx(1,1,1,1,1,2))
7755 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7756 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7757 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7758 & ADtEA1derx(1,1,1,1,1,2))
7760 C End 6-th order cumulants
7761 call transpose2(EUgder(1,1,l),auxmat(1,1))
7762 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7763 call transpose2(EUg(1,1,l),auxmat(1,1))
7764 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7765 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7769 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7770 & EAEAderx(1,1,lll,kkk,iii,2))
7775 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7776 C They are needed only when the fifth- or the sixth-order cumulants are
7778 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7779 call transpose2(AEA(1,1,1),auxmat(1,1))
7780 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7781 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7782 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7783 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7784 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7785 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7786 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7787 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7788 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7789 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7790 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7791 call transpose2(AEA(1,1,2),auxmat(1,1))
7792 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7793 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7794 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7795 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7796 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7797 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7798 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7799 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7800 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7801 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7802 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7803 C Calculate the Cartesian derivatives of the vectors.
7807 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7808 call matvec2(auxmat(1,1),b1(1,i),
7809 & AEAb1derx(1,lll,kkk,iii,1,1))
7810 call matvec2(auxmat(1,1),Ub2(1,i),
7811 & AEAb2derx(1,lll,kkk,iii,1,1))
7812 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7813 & AEAb1derx(1,lll,kkk,iii,2,1))
7814 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7815 & AEAb2derx(1,lll,kkk,iii,2,1))
7816 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7817 call matvec2(auxmat(1,1),b1(1,j),
7818 & AEAb1derx(1,lll,kkk,iii,1,2))
7819 call matvec2(auxmat(1,1),Ub2(1,j),
7820 & AEAb2derx(1,lll,kkk,iii,1,2))
7821 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7822 & AEAb1derx(1,lll,kkk,iii,2,2))
7823 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7824 & AEAb2derx(1,lll,kkk,iii,2,2))
7831 C Antiparallel orientation of the two CA-CA-CA frames.
7833 iti=itype2loc(itype(i))
7837 itk1=itype2loc(itype(k+1))
7838 itl=itype2loc(itype(l))
7839 itj=itype2loc(itype(j))
7840 if (j.lt.nres-1) then
7841 itj1=itype2loc(itype(j+1))
7845 C A2 kernel(j-1)T A1T
7846 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7847 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7848 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7849 C Following matrices are needed only for 6-th order cumulants
7850 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7851 & j.eq.i+4 .and. l.eq.i+3)) THEN
7852 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7853 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7854 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7855 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7856 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7857 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7858 & ADtEAderx(1,1,1,1,1,1))
7859 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7860 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7861 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7862 & ADtEA1derx(1,1,1,1,1,1))
7864 C End 6-th order cumulants
7865 call transpose2(EUgder(1,1,k),auxmat(1,1))
7866 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7867 call transpose2(EUg(1,1,k),auxmat(1,1))
7868 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7869 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7873 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7874 & EAEAderx(1,1,lll,kkk,iii,1))
7878 C A2T kernel(i+1)T A1
7879 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7880 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7881 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7882 C Following matrices are needed only for 6-th order cumulants
7883 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7884 & j.eq.i+4 .and. l.eq.i+3)) THEN
7885 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7886 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7887 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7888 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7889 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7890 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7891 & ADtEAderx(1,1,1,1,1,2))
7892 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7893 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7894 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7895 & ADtEA1derx(1,1,1,1,1,2))
7897 C End 6-th order cumulants
7898 call transpose2(EUgder(1,1,j),auxmat(1,1))
7899 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7900 call transpose2(EUg(1,1,j),auxmat(1,1))
7901 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7902 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7906 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7907 & EAEAderx(1,1,lll,kkk,iii,2))
7912 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7913 C They are needed only when the fifth- or the sixth-order cumulants are
7915 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7916 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7917 call transpose2(AEA(1,1,1),auxmat(1,1))
7918 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7919 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7920 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7921 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7922 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7923 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7924 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7925 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7926 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7927 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7928 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7929 call transpose2(AEA(1,1,2),auxmat(1,1))
7930 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7931 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7932 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7933 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7934 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7935 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7936 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7937 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7938 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7939 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7940 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7941 C Calculate the Cartesian derivatives of the vectors.
7945 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7946 call matvec2(auxmat(1,1),b1(1,i),
7947 & AEAb1derx(1,lll,kkk,iii,1,1))
7948 call matvec2(auxmat(1,1),Ub2(1,i),
7949 & AEAb2derx(1,lll,kkk,iii,1,1))
7950 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7951 & AEAb1derx(1,lll,kkk,iii,2,1))
7952 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7953 & AEAb2derx(1,lll,kkk,iii,2,1))
7954 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7955 call matvec2(auxmat(1,1),b1(1,l),
7956 & AEAb1derx(1,lll,kkk,iii,1,2))
7957 call matvec2(auxmat(1,1),Ub2(1,l),
7958 & AEAb2derx(1,lll,kkk,iii,1,2))
7959 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7960 & AEAb1derx(1,lll,kkk,iii,2,2))
7961 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7962 & AEAb2derx(1,lll,kkk,iii,2,2))
7971 C---------------------------------------------------------------------------
7972 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7973 & KK,KKderg,AKA,AKAderg,AKAderx)
7977 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7978 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7979 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7984 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7986 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7989 cd if (lprn) write (2,*) 'In kernel'
7991 cd if (lprn) write (2,*) 'kkk=',kkk
7993 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7994 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7996 cd write (2,*) 'lll=',lll
7997 cd write (2,*) 'iii=1'
7999 cd write (2,'(3(2f10.5),5x)')
8000 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8003 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8004 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8006 cd write (2,*) 'lll=',lll
8007 cd write (2,*) 'iii=2'
8009 cd write (2,'(3(2f10.5),5x)')
8010 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8017 C---------------------------------------------------------------------------
8018 double precision function eello4(i,j,k,l,jj,kk)
8019 implicit real*8 (a-h,o-z)
8020 include 'DIMENSIONS'
8021 include 'DIMENSIONS.ZSCOPT'
8022 include 'COMMON.IOUNITS'
8023 include 'COMMON.CHAIN'
8024 include 'COMMON.DERIV'
8025 include 'COMMON.INTERACT'
8026 include 'COMMON.CONTACTS'
8027 include 'COMMON.CONTMAT'
8028 include 'COMMON.CORRMAT'
8029 include 'COMMON.TORSION'
8030 include 'COMMON.VAR'
8031 include 'COMMON.GEO'
8032 double precision pizda(2,2),ggg1(3),ggg2(3)
8033 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8037 cd print *,'eello4:',i,j,k,l,jj,kk
8038 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8039 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8040 cold eij=facont_hb(jj,i)
8041 cold ekl=facont_hb(kk,k)
8043 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8045 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8046 gcorr_loc(k-1)=gcorr_loc(k-1)
8047 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8049 gcorr_loc(l-1)=gcorr_loc(l-1)
8050 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8052 gcorr_loc(j-1)=gcorr_loc(j-1)
8053 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8058 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8059 & -EAEAderx(2,2,lll,kkk,iii,1)
8060 cd derx(lll,kkk,iii)=0.0d0
8064 cd gcorr_loc(l-1)=0.0d0
8065 cd gcorr_loc(j-1)=0.0d0
8066 cd gcorr_loc(k-1)=0.0d0
8068 cd write (iout,*)'Contacts have occurred for peptide groups',
8069 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8070 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8071 if (j.lt.nres-1) then
8078 if (l.lt.nres-1) then
8086 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8087 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8088 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8089 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8090 cgrad ghalf=0.5d0*ggg1(ll)
8091 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8092 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8093 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8094 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8095 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8096 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8097 cgrad ghalf=0.5d0*ggg2(ll)
8098 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8099 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8100 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8101 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8102 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8103 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8107 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8112 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8117 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8122 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8126 cd write (2,*) iii,gcorr_loc(iii)
8130 cd write (2,*) 'ekont',ekont
8131 cd write (iout,*) 'eello4',ekont*eel4
8134 C---------------------------------------------------------------------------
8135 double precision function eello5(i,j,k,l,jj,kk)
8136 implicit real*8 (a-h,o-z)
8137 include 'DIMENSIONS'
8138 include 'DIMENSIONS.ZSCOPT'
8139 include 'COMMON.IOUNITS'
8140 include 'COMMON.CHAIN'
8141 include 'COMMON.DERIV'
8142 include 'COMMON.INTERACT'
8143 include 'COMMON.CONTACTS'
8144 include 'COMMON.CONTMAT'
8145 include 'COMMON.CORRMAT'
8146 include 'COMMON.TORSION'
8147 include 'COMMON.VAR'
8148 include 'COMMON.GEO'
8149 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8150 double precision ggg1(3),ggg2(3)
8151 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8156 C /l\ / \ \ / \ / \ / C
8157 C / \ / \ \ / \ / \ / C
8158 C j| o |l1 | o | o| o | | o |o C
8159 C \ |/k\| |/ \| / |/ \| |/ \| C
8160 C \i/ \ / \ / / \ / \ C
8162 C (I) (II) (III) (IV) C
8164 C eello5_1 eello5_2 eello5_3 eello5_4 C
8166 C Antiparallel chains C
8169 C /j\ / \ \ / \ / \ / C
8170 C / \ / \ \ / \ / \ / C
8171 C j1| o |l | o | o| o | | o |o C
8172 C \ |/k\| |/ \| / |/ \| |/ \| C
8173 C \i/ \ / \ / / \ / \ C
8175 C (I) (II) (III) (IV) C
8177 C eello5_1 eello5_2 eello5_3 eello5_4 C
8179 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8181 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8182 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8187 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8189 itk=itype2loc(itype(k))
8190 itl=itype2loc(itype(l))
8191 itj=itype2loc(itype(j))
8196 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8197 cd & eel5_3_num,eel5_4_num)
8201 derx(lll,kkk,iii)=0.0d0
8205 cd eij=facont_hb(jj,i)
8206 cd ekl=facont_hb(kk,k)
8208 cd write (iout,*)'Contacts have occurred for peptide groups',
8209 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8211 C Contribution from the graph I.
8212 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8213 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8214 call transpose2(EUg(1,1,k),auxmat(1,1))
8215 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8216 vv(1)=pizda(1,1)-pizda(2,2)
8217 vv(2)=pizda(1,2)+pizda(2,1)
8218 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8219 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8221 C Explicit gradient in virtual-dihedral angles.
8222 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8223 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8224 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8225 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8226 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8227 vv(1)=pizda(1,1)-pizda(2,2)
8228 vv(2)=pizda(1,2)+pizda(2,1)
8229 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8230 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8231 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8232 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8233 vv(1)=pizda(1,1)-pizda(2,2)
8234 vv(2)=pizda(1,2)+pizda(2,1)
8236 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8237 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8238 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8240 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8241 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8242 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8244 C Cartesian gradient
8248 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8250 vv(1)=pizda(1,1)-pizda(2,2)
8251 vv(2)=pizda(1,2)+pizda(2,1)
8252 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8253 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8254 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8261 C Contribution from graph II
8262 call transpose2(EE(1,1,k),auxmat(1,1))
8263 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8264 vv(1)=pizda(1,1)+pizda(2,2)
8265 vv(2)=pizda(2,1)-pizda(1,2)
8266 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8267 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8269 C Explicit gradient in virtual-dihedral angles.
8270 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8271 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8272 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8273 vv(1)=pizda(1,1)+pizda(2,2)
8274 vv(2)=pizda(2,1)-pizda(1,2)
8276 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8277 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8278 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8280 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8281 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8282 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8284 C Cartesian gradient
8288 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8290 vv(1)=pizda(1,1)+pizda(2,2)
8291 vv(2)=pizda(2,1)-pizda(1,2)
8292 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8293 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8294 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8303 C Parallel orientation
8304 C Contribution from graph III
8305 call transpose2(EUg(1,1,l),auxmat(1,1))
8306 call matmat2(AEA(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 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8310 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8312 C Explicit gradient in virtual-dihedral angles.
8313 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8314 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8315 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8316 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8317 vv(1)=pizda(1,1)-pizda(2,2)
8318 vv(2)=pizda(1,2)+pizda(2,1)
8319 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8320 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8321 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8322 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8323 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8324 vv(1)=pizda(1,1)-pizda(2,2)
8325 vv(2)=pizda(1,2)+pizda(2,1)
8326 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8327 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8328 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8329 C Cartesian gradient
8333 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8335 vv(1)=pizda(1,1)-pizda(2,2)
8336 vv(2)=pizda(1,2)+pizda(2,1)
8337 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8338 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8339 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8344 C Contribution from graph IV
8346 call transpose2(EE(1,1,l),auxmat(1,1))
8347 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8348 vv(1)=pizda(1,1)+pizda(2,2)
8349 vv(2)=pizda(2,1)-pizda(1,2)
8350 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8351 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8352 C Explicit gradient in virtual-dihedral angles.
8353 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8354 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8355 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8356 vv(1)=pizda(1,1)+pizda(2,2)
8357 vv(2)=pizda(2,1)-pizda(1,2)
8358 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8359 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8360 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8361 C Cartesian gradient
8365 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8367 vv(1)=pizda(1,1)+pizda(2,2)
8368 vv(2)=pizda(2,1)-pizda(1,2)
8369 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8370 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8371 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8377 C Antiparallel orientation
8378 C Contribution from graph III
8380 call transpose2(EUg(1,1,j),auxmat(1,1))
8381 call matmat2(AEA(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 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8385 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8387 C Explicit gradient in virtual-dihedral angles.
8388 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8389 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8390 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8391 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8392 vv(1)=pizda(1,1)-pizda(2,2)
8393 vv(2)=pizda(1,2)+pizda(2,1)
8394 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8395 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8396 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8397 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8398 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8399 vv(1)=pizda(1,1)-pizda(2,2)
8400 vv(2)=pizda(1,2)+pizda(2,1)
8401 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8402 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8403 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8404 C Cartesian gradient
8408 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8410 vv(1)=pizda(1,1)-pizda(2,2)
8411 vv(2)=pizda(1,2)+pizda(2,1)
8412 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8413 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8414 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8420 C Contribution from graph IV
8422 call transpose2(EE(1,1,j),auxmat(1,1))
8423 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8424 vv(1)=pizda(1,1)+pizda(2,2)
8425 vv(2)=pizda(2,1)-pizda(1,2)
8426 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8427 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8429 C Explicit gradient in virtual-dihedral angles.
8430 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8431 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8432 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8433 vv(1)=pizda(1,1)+pizda(2,2)
8434 vv(2)=pizda(2,1)-pizda(1,2)
8435 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8436 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8437 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8438 C Cartesian gradient
8442 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8444 vv(1)=pizda(1,1)+pizda(2,2)
8445 vv(2)=pizda(2,1)-pizda(1,2)
8446 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8447 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8448 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8455 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8456 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8457 cd write (2,*) 'ijkl',i,j,k,l
8458 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8459 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8461 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8462 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8463 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8464 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8466 if (j.lt.nres-1) then
8473 if (l.lt.nres-1) then
8483 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8484 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8485 C summed up outside the subrouine as for the other subroutines
8486 C handling long-range interactions. The old code is commented out
8487 C with "cgrad" to keep track of changes.
8489 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8490 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8491 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8492 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8493 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8494 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8495 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8496 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8497 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8498 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8500 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8501 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8502 cgrad ghalf=0.5d0*ggg1(ll)
8504 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8505 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8506 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8507 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8508 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8509 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8510 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8511 cgrad ghalf=0.5d0*ggg2(ll)
8513 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
8514 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8515 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
8516 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8517 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8518 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8524 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8525 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8530 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8531 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8537 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8542 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8546 cd write (2,*) iii,g_corr5_loc(iii)
8549 cd write (2,*) 'ekont',ekont
8550 cd write (iout,*) 'eello5',ekont*eel5
8553 c--------------------------------------------------------------------------
8554 double precision function eello6(i,j,k,l,jj,kk)
8555 implicit real*8 (a-h,o-z)
8556 include 'DIMENSIONS'
8557 include 'DIMENSIONS.ZSCOPT'
8558 include 'COMMON.IOUNITS'
8559 include 'COMMON.CHAIN'
8560 include 'COMMON.DERIV'
8561 include 'COMMON.INTERACT'
8562 include 'COMMON.CONTACTS'
8563 include 'COMMON.CONTMAT'
8564 include 'COMMON.CORRMAT'
8565 include 'COMMON.TORSION'
8566 include 'COMMON.VAR'
8567 include 'COMMON.GEO'
8568 include 'COMMON.FFIELD'
8569 double precision ggg1(3),ggg2(3)
8570 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8575 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8583 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8584 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8588 derx(lll,kkk,iii)=0.0d0
8592 cd eij=facont_hb(jj,i)
8593 cd ekl=facont_hb(kk,k)
8599 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8600 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8601 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8602 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8603 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8604 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8606 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8607 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8608 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8609 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8610 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8611 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8615 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8617 C If turn contributions are considered, they will be handled separately.
8618 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8619 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8620 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8621 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8622 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8623 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8624 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8627 if (j.lt.nres-1) then
8634 if (l.lt.nres-1) then
8642 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8643 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8644 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8645 cgrad ghalf=0.5d0*ggg1(ll)
8647 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8648 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8649 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8650 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8651 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8652 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8653 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8654 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8655 cgrad ghalf=0.5d0*ggg2(ll)
8656 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8658 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8659 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8660 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8661 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8662 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8663 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8669 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8670 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8675 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8676 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8682 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8687 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8691 cd write (2,*) iii,g_corr6_loc(iii)
8694 cd write (2,*) 'ekont',ekont
8695 cd write (iout,*) 'eello6',ekont*eel6
8698 c--------------------------------------------------------------------------
8699 double precision function eello6_graph1(i,j,k,l,imat,swap)
8700 implicit real*8 (a-h,o-z)
8701 include 'DIMENSIONS'
8702 include 'DIMENSIONS.ZSCOPT'
8703 include 'COMMON.IOUNITS'
8704 include 'COMMON.CHAIN'
8705 include 'COMMON.DERIV'
8706 include 'COMMON.INTERACT'
8707 include 'COMMON.CONTACTS'
8708 include 'COMMON.CONTMAT'
8709 include 'COMMON.CORRMAT'
8710 include 'COMMON.TORSION'
8711 include 'COMMON.VAR'
8712 include 'COMMON.GEO'
8713 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8717 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8719 C Parallel Antiparallel C
8725 C \ j|/k\| / \ |/k\|l / C
8730 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8731 itk=itype2loc(itype(k))
8732 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8733 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8734 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8735 call transpose2(EUgC(1,1,k),auxmat(1,1))
8736 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8737 vv1(1)=pizda1(1,1)-pizda1(2,2)
8738 vv1(2)=pizda1(1,2)+pizda1(2,1)
8739 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8740 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8741 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8742 s5=scalar2(vv(1),Dtobr2(1,i))
8743 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8744 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8746 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8747 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8748 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8749 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8750 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8751 & +scalar2(vv(1),Dtobr2der(1,i)))
8752 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8753 vv1(1)=pizda1(1,1)-pizda1(2,2)
8754 vv1(2)=pizda1(1,2)+pizda1(2,1)
8755 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8756 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8758 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8759 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8760 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8761 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8762 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8764 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8765 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8766 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8767 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8768 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8770 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8771 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8772 vv1(1)=pizda1(1,1)-pizda1(2,2)
8773 vv1(2)=pizda1(1,2)+pizda1(2,1)
8774 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8775 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8776 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8777 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8786 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8787 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8788 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8789 call transpose2(EUgC(1,1,k),auxmat(1,1))
8790 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8792 vv1(1)=pizda1(1,1)-pizda1(2,2)
8793 vv1(2)=pizda1(1,2)+pizda1(2,1)
8794 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8795 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8796 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8797 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8798 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8799 s5=scalar2(vv(1),Dtobr2(1,i))
8800 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8807 c----------------------------------------------------------------------------
8808 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8809 implicit real*8 (a-h,o-z)
8810 include 'DIMENSIONS'
8811 include 'DIMENSIONS.ZSCOPT'
8812 include 'COMMON.IOUNITS'
8813 include 'COMMON.CHAIN'
8814 include 'COMMON.DERIV'
8815 include 'COMMON.INTERACT'
8816 include 'COMMON.CONTACTS'
8817 include 'COMMON.CONTMAT'
8818 include 'COMMON.CORRMAT'
8819 include 'COMMON.TORSION'
8820 include 'COMMON.VAR'
8821 include 'COMMON.GEO'
8823 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8824 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8827 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8829 C Parallel Antiparallel C
8835 C \ j|/k\| \ |/k\|l C
8840 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8841 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8842 C AL 7/4/01 s1 would occur in the sixth-order moment,
8843 C but not in a cluster cumulant
8845 s1=dip(1,jj,i)*dip(1,kk,k)
8847 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8848 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8849 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8850 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8851 call transpose2(EUg(1,1,k),auxmat(1,1))
8852 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8853 vv(1)=pizda(1,1)-pizda(2,2)
8854 vv(2)=pizda(1,2)+pizda(2,1)
8855 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8856 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8858 eello6_graph2=-(s1+s2+s3+s4)
8860 eello6_graph2=-(s2+s3+s4)
8863 C Derivatives in gamma(i-1)
8867 s1=dipderg(1,jj,i)*dip(1,kk,k)
8869 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8870 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8871 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8872 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8874 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8876 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8878 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8880 C Derivatives in gamma(k-1)
8882 s1=dip(1,jj,i)*dipderg(1,kk,k)
8884 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8885 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8886 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8887 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8888 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8889 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8890 vv(1)=pizda(1,1)-pizda(2,2)
8891 vv(2)=pizda(1,2)+pizda(2,1)
8892 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8894 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8896 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8898 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8899 C Derivatives in gamma(j-1) or gamma(l-1)
8902 s1=dipderg(3,jj,i)*dip(1,kk,k)
8904 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8905 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8906 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8907 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8908 vv(1)=pizda(1,1)-pizda(2,2)
8909 vv(2)=pizda(1,2)+pizda(2,1)
8910 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8913 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8915 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8918 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8919 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8921 C Derivatives in gamma(l-1) or gamma(j-1)
8924 s1=dip(1,jj,i)*dipderg(3,kk,k)
8926 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8927 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8928 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8929 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8930 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8931 vv(1)=pizda(1,1)-pizda(2,2)
8932 vv(2)=pizda(1,2)+pizda(2,1)
8933 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8936 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8938 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8941 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8942 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8944 C Cartesian derivatives.
8946 write (2,*) 'In eello6_graph2'
8948 write (2,*) 'iii=',iii
8950 write (2,*) 'kkk=',kkk
8952 write (2,'(3(2f10.5),5x)')
8953 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8963 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8965 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8968 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8970 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8971 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8973 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8974 call transpose2(EUg(1,1,k),auxmat(1,1))
8975 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8977 vv(1)=pizda(1,1)-pizda(2,2)
8978 vv(2)=pizda(1,2)+pizda(2,1)
8979 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8980 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8982 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8984 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8987 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8989 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8997 c----------------------------------------------------------------------------
8998 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8999 implicit real*8 (a-h,o-z)
9000 include 'DIMENSIONS'
9001 include 'DIMENSIONS.ZSCOPT'
9002 include 'COMMON.IOUNITS'
9003 include 'COMMON.CHAIN'
9004 include 'COMMON.DERIV'
9005 include 'COMMON.INTERACT'
9006 include 'COMMON.CONTACTS'
9007 include 'COMMON.CONTMAT'
9008 include 'COMMON.CORRMAT'
9009 include 'COMMON.TORSION'
9010 include 'COMMON.VAR'
9011 include 'COMMON.GEO'
9012 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9014 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9016 C Parallel Antiparallel C
9022 C j|/k\| / |/k\|l / C
9027 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9029 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9030 C energy moment and not to the cluster cumulant.
9031 iti=itortyp(itype(i))
9032 if (j.lt.nres-1) then
9033 itj1=itype2loc(itype(j+1))
9037 itk=itype2loc(itype(k))
9038 itk1=itype2loc(itype(k+1))
9039 if (l.lt.nres-1) then
9040 itl1=itype2loc(itype(l+1))
9045 s1=dip(4,jj,i)*dip(4,kk,k)
9047 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9048 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9049 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9050 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9051 call transpose2(EE(1,1,k),auxmat(1,1))
9052 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9053 vv(1)=pizda(1,1)+pizda(2,2)
9054 vv(2)=pizda(2,1)-pizda(1,2)
9055 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9056 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9057 cd & "sum",-(s2+s3+s4)
9059 eello6_graph3=-(s1+s2+s3+s4)
9061 eello6_graph3=-(s2+s3+s4)
9064 C Derivatives in gamma(k-1)
9066 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9067 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9068 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9069 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9070 C Derivatives in gamma(l-1)
9071 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9072 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9073 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9074 vv(1)=pizda(1,1)+pizda(2,2)
9075 vv(2)=pizda(2,1)-pizda(1,2)
9076 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9077 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9078 C Cartesian derivatives.
9084 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9086 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9089 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9091 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9092 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9094 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9095 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9097 vv(1)=pizda(1,1)+pizda(2,2)
9098 vv(2)=pizda(2,1)-pizda(1,2)
9099 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9101 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9103 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9106 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9108 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9110 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9117 c----------------------------------------------------------------------------
9118 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9119 implicit real*8 (a-h,o-z)
9120 include 'DIMENSIONS'
9121 include 'DIMENSIONS.ZSCOPT'
9122 include 'COMMON.IOUNITS'
9123 include 'COMMON.CHAIN'
9124 include 'COMMON.DERIV'
9125 include 'COMMON.INTERACT'
9126 include 'COMMON.CONTACTS'
9127 include 'COMMON.CONTMAT'
9128 include 'COMMON.CORRMAT'
9129 include 'COMMON.TORSION'
9130 include 'COMMON.VAR'
9131 include 'COMMON.GEO'
9132 include 'COMMON.FFIELD'
9133 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9134 & auxvec1(2),auxmat1(2,2)
9136 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9138 C Parallel Antiparallel C
9144 C \ j|/k\| \ |/k\|l C
9149 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9151 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9152 C energy moment and not to the cluster cumulant.
9153 cd write (2,*) 'eello_graph4: wturn6',wturn6
9154 iti=itype2loc(itype(i))
9155 itj=itype2loc(itype(j))
9156 if (j.lt.nres-1) then
9157 itj1=itype2loc(itype(j+1))
9161 itk=itype2loc(itype(k))
9162 if (k.lt.nres-1) then
9163 itk1=itype2loc(itype(k+1))
9167 itl=itype2loc(itype(l))
9168 if (l.lt.nres-1) then
9169 itl1=itype2loc(itype(l+1))
9173 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9174 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9175 cd & ' itl',itl,' itl1',itl1
9178 s1=dip(3,jj,i)*dip(3,kk,k)
9180 s1=dip(2,jj,j)*dip(2,kk,l)
9183 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9184 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9186 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9187 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9189 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9190 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9192 call transpose2(EUg(1,1,k),auxmat(1,1))
9193 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9194 vv(1)=pizda(1,1)-pizda(2,2)
9195 vv(2)=pizda(2,1)+pizda(1,2)
9196 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9197 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9199 eello6_graph4=-(s1+s2+s3+s4)
9201 eello6_graph4=-(s2+s3+s4)
9203 C Derivatives in gamma(i-1)
9208 s1=dipderg(2,jj,i)*dip(3,kk,k)
9210 s1=dipderg(4,jj,j)*dip(2,kk,l)
9213 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9215 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9216 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9218 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9219 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9221 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9222 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9223 cd write (2,*) 'turn6 derivatives'
9225 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9227 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9231 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9233 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9237 C Derivatives in gamma(k-1)
9240 s1=dip(3,jj,i)*dipderg(2,kk,k)
9242 s1=dip(2,jj,j)*dipderg(4,kk,l)
9245 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9246 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9248 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9249 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9251 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9252 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9254 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9255 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9256 vv(1)=pizda(1,1)-pizda(2,2)
9257 vv(2)=pizda(2,1)+pizda(1,2)
9258 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9259 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9261 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9263 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9267 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9269 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9272 C Derivatives in gamma(j-1) or gamma(l-1)
9273 if (l.eq.j+1 .and. l.gt.1) then
9274 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9275 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9276 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9277 vv(1)=pizda(1,1)-pizda(2,2)
9278 vv(2)=pizda(2,1)+pizda(1,2)
9279 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9280 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9281 else if (j.gt.1) then
9282 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9283 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9284 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9285 vv(1)=pizda(1,1)-pizda(2,2)
9286 vv(2)=pizda(2,1)+pizda(1,2)
9287 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9288 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9289 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9291 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9294 C Cartesian derivatives.
9301 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9303 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9307 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9309 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9313 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9315 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9317 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9318 & b1(1,j+1),auxvec(1))
9319 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9321 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9322 & b1(1,l+1),auxvec(1))
9323 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9325 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9327 vv(1)=pizda(1,1)-pizda(2,2)
9328 vv(2)=pizda(2,1)+pizda(1,2)
9329 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9331 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9333 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9336 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9339 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9342 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9344 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9346 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9350 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9352 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9355 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9357 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9366 c----------------------------------------------------------------------------
9367 double precision function eello_turn6(i,jj,kk)
9368 implicit real*8 (a-h,o-z)
9369 include 'DIMENSIONS'
9370 include 'DIMENSIONS.ZSCOPT'
9371 include 'COMMON.IOUNITS'
9372 include 'COMMON.CHAIN'
9373 include 'COMMON.DERIV'
9374 include 'COMMON.INTERACT'
9375 include 'COMMON.CONTACTS'
9376 include 'COMMON.CONTMAT'
9377 include 'COMMON.CORRMAT'
9378 include 'COMMON.TORSION'
9379 include 'COMMON.VAR'
9380 include 'COMMON.GEO'
9381 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9382 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9384 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9385 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9386 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9387 C the respective energy moment and not to the cluster cumulant.
9396 iti=itype2loc(itype(i))
9397 itk=itype2loc(itype(k))
9398 itk1=itype2loc(itype(k+1))
9399 itl=itype2loc(itype(l))
9400 itj=itype2loc(itype(j))
9401 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9402 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9403 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9408 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9410 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9414 derx_turn(lll,kkk,iii)=0.0d0
9421 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9423 cd write (2,*) 'eello6_5',eello6_5
9425 call transpose2(AEA(1,1,1),auxmat(1,1))
9426 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9427 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9428 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9430 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9431 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9432 s2 = scalar2(b1(1,k),vtemp1(1))
9434 call transpose2(AEA(1,1,2),atemp(1,1))
9435 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9436 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
9437 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9439 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9440 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9441 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9443 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9444 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9445 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9446 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9447 ss13 = scalar2(b1(1,k),vtemp4(1))
9448 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9450 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9456 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9457 C Derivatives in gamma(i+2)
9462 call transpose2(AEA(1,1,1),auxmatd(1,1))
9463 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9464 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9465 call transpose2(AEAderg(1,1,2),atempd(1,1))
9466 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9467 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9469 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9470 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9471 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9477 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9478 C Derivatives in gamma(i+3)
9480 call transpose2(AEA(1,1,1),auxmatd(1,1))
9481 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9482 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9483 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9485 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9486 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9487 s2d = scalar2(b1(1,k),vtemp1d(1))
9489 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
9490 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
9492 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9494 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9495 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9496 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9504 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9505 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9507 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9508 & -0.5d0*ekont*(s2d+s12d)
9510 C Derivatives in gamma(i+4)
9511 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9512 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9513 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9515 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9516 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9517 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9525 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9527 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9529 C Derivatives in gamma(i+5)
9531 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9532 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9533 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9535 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9536 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9537 s2d = scalar2(b1(1,k),vtemp1d(1))
9539 call transpose2(AEA(1,1,2),atempd(1,1))
9540 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9541 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
9543 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9544 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9546 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9547 ss13d = scalar2(b1(1,k),vtemp4d(1))
9548 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9556 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9557 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9559 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9560 & -0.5d0*ekont*(s2d+s12d)
9562 C Cartesian derivatives
9567 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9568 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9569 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9571 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9572 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9574 s2d = scalar2(b1(1,k),vtemp1d(1))
9576 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9577 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9578 s8d = -(atempd(1,1)+atempd(2,2))*
9579 & scalar2(cc(1,1,l),vtemp2(1))
9581 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9583 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9584 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9591 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9594 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9598 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9599 & - 0.5d0*(s8d+s12d)
9601 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9610 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9612 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9613 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9614 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9615 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9616 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9618 ss13d = scalar2(b1(1,k),vtemp4d(1))
9619 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9620 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9624 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9625 cd & 16*eel_turn6_num
9627 if (j.lt.nres-1) then
9634 if (l.lt.nres-1) then
9642 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9643 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9644 cgrad ghalf=0.5d0*ggg1(ll)
9646 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9647 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9648 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9649 & +ekont*derx_turn(ll,2,1)
9650 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9651 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9652 & +ekont*derx_turn(ll,4,1)
9653 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9654 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9655 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9656 cgrad ghalf=0.5d0*ggg2(ll)
9658 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9659 & +ekont*derx_turn(ll,2,2)
9660 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9661 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9662 & +ekont*derx_turn(ll,4,2)
9663 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9664 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9665 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9670 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9675 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9681 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9686 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9690 cd write (2,*) iii,g_corr6_loc(iii)
9693 eello_turn6=ekont*eel_turn6
9694 cd write (2,*) 'ekont',ekont
9695 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9699 crc-------------------------------------------------
9700 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9701 subroutine Eliptransfer(eliptran)
9702 implicit real*8 (a-h,o-z)
9703 include 'DIMENSIONS'
9704 include 'DIMENSIONS.ZSCOPT'
9705 include 'COMMON.GEO'
9706 include 'COMMON.VAR'
9707 include 'COMMON.LOCAL'
9708 include 'COMMON.CHAIN'
9709 include 'COMMON.DERIV'
9710 include 'COMMON.INTERACT'
9711 include 'COMMON.IOUNITS'
9712 include 'COMMON.CALC'
9713 include 'COMMON.CONTROL'
9714 include 'COMMON.SPLITELE'
9715 include 'COMMON.SBRIDGE'
9716 C this is done by Adasko
9720 C--bordliptop-- buffore starts
9721 C--bufliptop--- here true lipid starts
9723 C--buflipbot--- lipid ends buffore starts
9724 C--bordlipbot--buffore ends
9728 if (itype(i).eq.ntyp1) cycle
9730 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
9731 if (positi.le.0) positi=positi+boxzsize
9733 C first for peptide groups
9734 c for each residue check if it is in lipid or lipid water border area
9735 if ((positi.gt.bordlipbot)
9736 &.and.(positi.lt.bordliptop)) then
9737 C the energy transfer exist
9738 if (positi.lt.buflipbot) then
9739 C what fraction I am in
9741 & ((positi-bordlipbot)/lipbufthick)
9742 C lipbufthick is thickenes of lipid buffore
9743 sslip=sscalelip(fracinbuf)
9744 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9745 eliptran=eliptran+sslip*pepliptran
9746 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9747 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9748 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9749 elseif (positi.gt.bufliptop) then
9750 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
9751 sslip=sscalelip(fracinbuf)
9752 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9753 eliptran=eliptran+sslip*pepliptran
9754 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
9755 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
9756 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
9757 C print *, "doing sscalefor top part"
9758 C print *,i,sslip,fracinbuf,ssgradlip
9760 eliptran=eliptran+pepliptran
9761 C print *,"I am in true lipid"
9764 C eliptran=elpitran+0.0 ! I am in water
9767 C print *, "nic nie bylo w lipidzie?"
9768 C now multiply all by the peptide group transfer factor
9769 C eliptran=eliptran*pepliptran
9770 C now the same for side chains
9773 if (itype(i).eq.ntyp1) cycle
9774 positi=(mod(c(3,i+nres),boxzsize))
9775 if (positi.le.0) positi=positi+boxzsize
9776 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9777 c for each residue check if it is in lipid or lipid water border area
9778 C respos=mod(c(3,i+nres),boxzsize)
9779 C print *,positi,bordlipbot,buflipbot
9780 if ((positi.gt.bordlipbot)
9781 & .and.(positi.lt.bordliptop)) then
9782 C the energy transfer exist
9783 if (positi.lt.buflipbot) then
9785 & ((positi-bordlipbot)/lipbufthick)
9786 C lipbufthick is thickenes of lipid buffore
9787 sslip=sscalelip(fracinbuf)
9788 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9789 eliptran=eliptran+sslip*liptranene(itype(i))
9790 gliptranx(3,i)=gliptranx(3,i)
9791 &+ssgradlip*liptranene(itype(i))
9792 gliptranc(3,i-1)= gliptranc(3,i-1)
9793 &+ssgradlip*liptranene(itype(i))
9794 C print *,"doing sccale for lower part"
9795 elseif (positi.gt.bufliptop) then
9797 &((bordliptop-positi)/lipbufthick)
9798 sslip=sscalelip(fracinbuf)
9799 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9800 eliptran=eliptran+sslip*liptranene(itype(i))
9801 gliptranx(3,i)=gliptranx(3,i)
9802 &+ssgradlip*liptranene(itype(i))
9803 gliptranc(3,i-1)= gliptranc(3,i-1)
9804 &+ssgradlip*liptranene(itype(i))
9805 C print *, "doing sscalefor top part",sslip,fracinbuf
9807 eliptran=eliptran+liptranene(itype(i))
9808 C print *,"I am in true lipid"
9810 endif ! if in lipid or buffor
9812 C eliptran=elpitran+0.0 ! I am in water
9818 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9820 SUBROUTINE MATVEC2(A1,V1,V2)
9821 implicit real*8 (a-h,o-z)
9822 include 'DIMENSIONS'
9823 DIMENSION A1(2,2),V1(2),V2(2)
9827 c 3 VI=VI+A1(I,K)*V1(K)
9831 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9832 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9837 C---------------------------------------
9838 SUBROUTINE MATMAT2(A1,A2,A3)
9839 implicit real*8 (a-h,o-z)
9840 include 'DIMENSIONS'
9841 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9842 c DIMENSION AI3(2,2)
9846 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9852 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9853 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9854 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9855 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9863 c-------------------------------------------------------------------------
9864 double precision function scalar2(u,v)
9866 double precision u(2),v(2)
9869 scalar2=u(1)*v(1)+u(2)*v(2)
9873 C-----------------------------------------------------------------------------
9875 subroutine transpose2(a,at)
9877 double precision a(2,2),at(2,2)
9884 c--------------------------------------------------------------------------
9885 subroutine transpose(n,a,at)
9888 double precision a(n,n),at(n,n)
9896 C---------------------------------------------------------------------------
9897 subroutine prodmat3(a1,a2,kk,transp,prod)
9900 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9902 crc double precision auxmat(2,2),prod_(2,2)
9905 crc call transpose2(kk(1,1),auxmat(1,1))
9906 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9907 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9909 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9910 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9911 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9912 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9913 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9914 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9915 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9916 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9919 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9920 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9922 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9923 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9924 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9925 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9926 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9927 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9928 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9929 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9932 c call transpose2(a2(1,1),a2t(1,1))
9935 crc print *,((prod_(i,j),i=1,2),j=1,2)
9936 crc print *,((prod(i,j),i=1,2),j=1,2)
9940 C-----------------------------------------------------------------------------
9941 double precision function scalar(u,v)
9943 double precision u(3),v(3)
9953 C-----------------------------------------------------------------------
9954 double precision function sscale(r)
9955 double precision r,gamm
9956 include "COMMON.SPLITELE"
9957 if(r.lt.r_cut-rlamb) then
9959 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9960 gamm=(r-(r_cut-rlamb))/rlamb
9961 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9967 C-----------------------------------------------------------------------
9968 C-----------------------------------------------------------------------
9969 double precision function sscagrad(r)
9970 double precision r,gamm
9971 include "COMMON.SPLITELE"
9972 if(r.lt.r_cut-rlamb) then
9974 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9975 gamm=(r-(r_cut-rlamb))/rlamb
9976 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9982 C-----------------------------------------------------------------------
9983 C-----------------------------------------------------------------------
9984 double precision function sscalelip(r)
9985 double precision r,gamm
9986 include "COMMON.SPLITELE"
9987 C if(r.lt.r_cut-rlamb) then
9989 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9990 C gamm=(r-(r_cut-rlamb))/rlamb
9991 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9997 C-----------------------------------------------------------------------
9998 double precision function sscagradlip(r)
9999 double precision r,gamm
10000 include "COMMON.SPLITELE"
10001 C if(r.lt.r_cut-rlamb) then
10003 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
10004 C gamm=(r-(r_cut-rlamb))/rlamb
10005 sscagradlip=r*(6*r-6.0d0)
10012 C-----------------------------------------------------------------------
10013 subroutine set_shield_fac
10014 implicit real*8 (a-h,o-z)
10015 include 'DIMENSIONS'
10016 include 'DIMENSIONS.ZSCOPT'
10017 include 'COMMON.CHAIN'
10018 include 'COMMON.DERIV'
10019 include 'COMMON.IOUNITS'
10020 include 'COMMON.SHIELD'
10021 include 'COMMON.INTERACT'
10022 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10023 double precision div77_81/0.974996043d0/,
10024 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10026 C the vector between center of side_chain and peptide group
10027 double precision pep_side(3),long,side_calf(3),
10028 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10029 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10030 C the line belowe needs to be changed for FGPROC>1
10032 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10034 Cif there two consequtive dummy atoms there is no peptide group between them
10035 C the line below has to be changed for FGPROC>1
10038 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10042 C first lets set vector conecting the ithe side-chain with kth side-chain
10043 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10044 C pep_side(j)=2.0d0
10045 C and vector conecting the side-chain with its proper calfa
10046 side_calf(j)=c(j,k+nres)-c(j,k)
10047 C side_calf(j)=2.0d0
10048 pept_group(j)=c(j,i)-c(j,i+1)
10049 C lets have their lenght
10050 dist_pep_side=pep_side(j)**2+dist_pep_side
10051 dist_side_calf=dist_side_calf+side_calf(j)**2
10052 dist_pept_group=dist_pept_group+pept_group(j)**2
10054 dist_pep_side=dsqrt(dist_pep_side)
10055 dist_pept_group=dsqrt(dist_pept_group)
10056 dist_side_calf=dsqrt(dist_side_calf)
10058 pep_side_norm(j)=pep_side(j)/dist_pep_side
10059 side_calf_norm(j)=dist_side_calf
10061 C now sscale fraction
10062 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10063 C print *,buff_shield,"buff"
10065 if (sh_frac_dist.le.0.0) cycle
10066 C If we reach here it means that this side chain reaches the shielding sphere
10067 C Lets add him to the list for gradient
10068 ishield_list(i)=ishield_list(i)+1
10069 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10070 C this list is essential otherwise problem would be O3
10071 shield_list(ishield_list(i),i)=k
10072 C Lets have the sscale value
10073 if (sh_frac_dist.gt.1.0) then
10074 scale_fac_dist=1.0d0
10076 sh_frac_dist_grad(j)=0.0d0
10079 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10080 & *(2.0*sh_frac_dist-3.0d0)
10081 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
10082 & /dist_pep_side/buff_shield*0.5
10083 C remember for the final gradient multiply sh_frac_dist_grad(j)
10084 C for side_chain by factor -2 !
10086 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10087 C print *,"jestem",scale_fac_dist,fac_help_scale,
10088 C & sh_frac_dist_grad(j)
10091 C if ((i.eq.3).and.(k.eq.2)) then
10092 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
10096 C this is what is now we have the distance scaling now volume...
10097 short=short_r_sidechain(itype(k))
10098 long=long_r_sidechain(itype(k))
10099 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
10102 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
10103 C costhet_fac=0.0d0
10105 costhet_grad(j)=costhet_fac*pep_side(j)
10107 C remember for the final gradient multiply costhet_grad(j)
10108 C for side_chain by factor -2 !
10109 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10110 C pep_side0pept_group is vector multiplication
10111 pep_side0pept_group=0.0
10113 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10115 cosalfa=(pep_side0pept_group/
10116 & (dist_pep_side*dist_side_calf))
10117 fac_alfa_sin=1.0-cosalfa**2
10118 fac_alfa_sin=dsqrt(fac_alfa_sin)
10119 rkprim=fac_alfa_sin*(long-short)+short
10121 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
10122 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
10125 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10126 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10127 &*(long-short)/fac_alfa_sin*cosalfa/
10128 &((dist_pep_side*dist_side_calf))*
10129 &((side_calf(j))-cosalfa*
10130 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10132 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
10133 &*(long-short)/fac_alfa_sin*cosalfa
10134 &/((dist_pep_side*dist_side_calf))*
10136 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10139 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
10142 C now the gradient...
10143 C grad_shield is gradient of Calfa for peptide groups
10144 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
10146 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
10147 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
10149 grad_shield(j,i)=grad_shield(j,i)
10150 C gradient po skalowaniu
10151 & +(sh_frac_dist_grad(j)
10152 C gradient po costhet
10153 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
10154 &-scale_fac_dist*(cosphi_grad_long(j))
10155 &/(1.0-cosphi) )*div77_81
10157 C grad_shield_side is Cbeta sidechain gradient
10158 grad_shield_side(j,ishield_list(i),i)=
10159 & (sh_frac_dist_grad(j)*(-2.0d0)
10160 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
10161 & +scale_fac_dist*(cosphi_grad_long(j))
10162 & *2.0d0/(1.0-cosphi))
10163 & *div77_81*VofOverlap
10165 grad_shield_loc(j,ishield_list(i),i)=
10166 & scale_fac_dist*cosphi_grad_loc(j)
10167 & *2.0d0/(1.0-cosphi)
10168 & *div77_81*VofOverlap
10170 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10172 fac_shield(i)=VolumeTotal*div77_81+div4_81
10173 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
10177 C--------------------------------------------------------------------------
10178 C first for shielding is setting of function of side-chains
10179 subroutine set_shield_fac2
10180 implicit real*8 (a-h,o-z)
10181 include 'DIMENSIONS'
10182 include 'DIMENSIONS.ZSCOPT'
10183 include 'COMMON.CHAIN'
10184 include 'COMMON.DERIV'
10185 include 'COMMON.IOUNITS'
10186 include 'COMMON.SHIELD'
10187 include 'COMMON.INTERACT'
10188 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
10189 double precision div77_81/0.974996043d0/,
10190 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
10192 C the vector between center of side_chain and peptide group
10193 double precision pep_side(3),long,side_calf(3),
10194 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
10195 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
10196 C the line belowe needs to be changed for FGPROC>1
10198 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
10200 Cif there two consequtive dummy atoms there is no peptide group between them
10201 C the line below has to be changed for FGPROC>1
10204 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
10208 C first lets set vector conecting the ithe side-chain with kth side-chain
10209 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
10210 C pep_side(j)=2.0d0
10211 C and vector conecting the side-chain with its proper calfa
10212 side_calf(j)=c(j,k+nres)-c(j,k)
10213 C side_calf(j)=2.0d0
10214 pept_group(j)=c(j,i)-c(j,i+1)
10215 C lets have their lenght
10216 dist_pep_side=pep_side(j)**2+dist_pep_side
10217 dist_side_calf=dist_side_calf+side_calf(j)**2
10218 dist_pept_group=dist_pept_group+pept_group(j)**2
10220 dist_pep_side=dsqrt(dist_pep_side)
10221 dist_pept_group=dsqrt(dist_pept_group)
10222 dist_side_calf=dsqrt(dist_side_calf)
10224 pep_side_norm(j)=pep_side(j)/dist_pep_side
10225 side_calf_norm(j)=dist_side_calf
10227 C now sscale fraction
10228 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
10229 C print *,buff_shield,"buff"
10231 if (sh_frac_dist.le.0.0) cycle
10232 C If we reach here it means that this side chain reaches the shielding sphere
10233 C Lets add him to the list for gradient
10234 ishield_list(i)=ishield_list(i)+1
10235 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
10236 C this list is essential otherwise problem would be O3
10237 shield_list(ishield_list(i),i)=k
10238 C Lets have the sscale value
10239 if (sh_frac_dist.gt.1.0) then
10240 scale_fac_dist=1.0d0
10242 sh_frac_dist_grad(j)=0.0d0
10245 scale_fac_dist=-sh_frac_dist*sh_frac_dist
10246 & *(2.0d0*sh_frac_dist-3.0d0)
10247 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
10248 & /dist_pep_side/buff_shield*0.5d0
10249 C remember for the final gradient multiply sh_frac_dist_grad(j)
10250 C for side_chain by factor -2 !
10252 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
10253 C sh_frac_dist_grad(j)=0.0d0
10254 C scale_fac_dist=1.0d0
10255 C print *,"jestem",scale_fac_dist,fac_help_scale,
10256 C & sh_frac_dist_grad(j)
10259 C this is what is now we have the distance scaling now volume...
10260 short=short_r_sidechain(itype(k))
10261 long=long_r_sidechain(itype(k))
10262 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
10263 sinthet=short/dist_pep_side*costhet
10267 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
10268 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
10269 C & -short/dist_pep_side**2/costhet)
10270 C costhet_fac=0.0d0
10272 costhet_grad(j)=costhet_fac*pep_side(j)
10274 C remember for the final gradient multiply costhet_grad(j)
10275 C for side_chain by factor -2 !
10276 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
10277 C pep_side0pept_group is vector multiplication
10278 pep_side0pept_group=0.0d0
10280 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
10282 cosalfa=(pep_side0pept_group/
10283 & (dist_pep_side*dist_side_calf))
10284 fac_alfa_sin=1.0d0-cosalfa**2
10285 fac_alfa_sin=dsqrt(fac_alfa_sin)
10286 rkprim=fac_alfa_sin*(long-short)+short
10290 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
10292 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
10293 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
10294 & dist_pep_side**2)
10297 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
10298 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10299 &*(long-short)/fac_alfa_sin*cosalfa/
10300 &((dist_pep_side*dist_side_calf))*
10301 &((side_calf(j))-cosalfa*
10302 &((pep_side(j)/dist_pep_side)*dist_side_calf))
10303 C cosphi_grad_long(j)=0.0d0
10304 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
10305 &*(long-short)/fac_alfa_sin*cosalfa
10306 &/((dist_pep_side*dist_side_calf))*
10308 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
10309 C cosphi_grad_loc(j)=0.0d0
10311 C print *,sinphi,sinthet
10312 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
10315 C now the gradient...
10317 grad_shield(j,i)=grad_shield(j,i)
10318 C gradient po skalowaniu
10319 & +(sh_frac_dist_grad(j)*VofOverlap
10320 C gradient po costhet
10321 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
10322 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10323 & sinphi/sinthet*costhet*costhet_grad(j)
10324 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10326 C grad_shield_side is Cbeta sidechain gradient
10327 grad_shield_side(j,ishield_list(i),i)=
10328 & (sh_frac_dist_grad(j)*(-2.0d0)
10330 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10331 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
10332 & sinphi/sinthet*costhet*costhet_grad(j)
10333 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
10336 grad_shield_loc(j,ishield_list(i),i)=
10337 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
10338 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
10339 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
10343 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
10345 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
10346 c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i),
10347 c & " wshield",wshield
10348 c write(2,*) "TU",rpp(1,1),short,long,buff_shield
10352 C--------------------------------------------------------------------------
10353 double precision function tschebyshev(m,n,x,y)
10355 include "DIMENSIONS"
10357 double precision x(n),y,yy(0:maxvar),aux
10358 c Tschebyshev polynomial. Note that the first term is omitted
10359 c m=0: the constant term is included
10360 c m=1: the constant term is not included
10364 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
10373 C--------------------------------------------------------------------------
10374 double precision function gradtschebyshev(m,n,x,y)
10376 include "DIMENSIONS"
10378 double precision x(n+1),y,yy(0:maxvar),aux
10379 c Tschebyshev polynomial. Note that the first term is omitted
10380 c m=0: the constant term is included
10381 c m=1: the constant term is not included
10385 yy(i)=2*y*yy(i-1)-yy(i-2)
10389 aux=aux+x(i+1)*yy(i)*(i+1)
10390 C print *, x(i+1),yy(i),i
10392 gradtschebyshev=aux
10395 c----------------------------------------------------------------------------
10396 double precision function sscale2(r,r_cut,r0,rlamb)
10398 double precision r,gamm,r_cut,r0,rlamb,rr
10400 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
10401 c write (2,*) "rr",rr
10402 if(rr.lt.r_cut-rlamb) then
10404 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10405 gamm=(rr-(r_cut-rlamb))/rlamb
10406 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
10412 C-----------------------------------------------------------------------
10413 double precision function sscalgrad2(r,r_cut,r0,rlamb)
10415 double precision r,gamm,r_cut,r0,rlamb,rr
10417 if(rr.lt.r_cut-rlamb) then
10419 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
10420 gamm=(rr-(r_cut-rlamb))/rlamb
10422 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
10424 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
10431 c----------------------------------------------------------------------------
10432 subroutine e_saxs(Esaxs_constr)
10434 include 'DIMENSIONS'
10435 include 'DIMENSIONS.ZSCOPT'
10436 include 'DIMENSIONS.FREE'
10439 include "COMMON.SETUP"
10442 include 'COMMON.SBRIDGE'
10443 include 'COMMON.CHAIN'
10444 include 'COMMON.GEO'
10445 include 'COMMON.LOCAL'
10446 include 'COMMON.INTERACT'
10447 include 'COMMON.VAR'
10448 include 'COMMON.IOUNITS'
10449 include 'COMMON.DERIV'
10450 include 'COMMON.CONTROL'
10451 include 'COMMON.NAMES'
10452 include 'COMMON.FFIELD'
10453 include 'COMMON.LANGEVIN'
10454 include 'COMMON.SAXS'
10456 double precision Esaxs_constr
10457 integer i,iint,j,k,l
10458 double precision PgradC(maxSAXS,3,maxres),
10459 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
10461 double precision PgradC_(maxSAXS,3,maxres),
10462 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
10464 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
10465 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
10466 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
10467 & auxX,auxX1,CACAgrad,Cnorm
10468 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
10469 double precision dist
10471 c SAXS restraint penalty function
10473 write(iout,*) "------- SAXS penalty function start -------"
10474 write (iout,*) "nsaxs",nsaxs
10475 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
10476 write (iout,*) "Psaxs"
10478 write (iout,'(i5,e15.5)') i, Psaxs(i)
10481 Esaxs_constr = 0.0d0
10486 PgradC(k,l,j)=0.0d0
10487 PgradX(k,l,j)=0.0d0
10491 do i=iatsc_s,iatsc_e
10492 if (itype(i).eq.ntyp1) cycle
10493 do iint=1,nint_gr(i)
10494 do j=istart(i,iint),iend(i,iint)
10495 if (itype(j).eq.ntyp1) cycle
10498 dijCASC=dist(i,j+nres)
10499 dijSCCA=dist(i+nres,j)
10500 dijSCSC=dist(i+nres,j+nres)
10501 sigma2CACA=2.0d0/(pstok**2)
10502 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
10503 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
10504 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
10507 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10508 if (itype(j).ne.10) then
10509 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
10513 if (itype(i).ne.10) then
10514 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
10518 if (itype(i).ne.10 .and. itype(j).ne.10) then
10519 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
10523 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
10525 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10527 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10528 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
10529 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
10530 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
10533 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10534 PgradC(k,l,i) = PgradC(k,l,i)-aux
10535 PgradC(k,l,j) = PgradC(k,l,j)+aux
10537 if (itype(j).ne.10) then
10538 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
10539 PgradC(k,l,i) = PgradC(k,l,i)-aux
10540 PgradC(k,l,j) = PgradC(k,l,j)+aux
10541 PgradX(k,l,j) = PgradX(k,l,j)+aux
10544 if (itype(i).ne.10) then
10545 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
10546 PgradX(k,l,i) = PgradX(k,l,i)-aux
10547 PgradC(k,l,i) = PgradC(k,l,i)-aux
10548 PgradC(k,l,j) = PgradC(k,l,j)+aux
10551 if (itype(i).ne.10 .and. itype(j).ne.10) then
10552 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
10553 PgradC(k,l,i) = PgradC(k,l,i)-aux
10554 PgradC(k,l,j) = PgradC(k,l,j)+aux
10555 PgradX(k,l,i) = PgradX(k,l,i)-aux
10556 PgradX(k,l,j) = PgradX(k,l,j)+aux
10562 sigma2CACA=scal_rad**2*0.25d0/
10563 & (restok(itype(j))**2+restok(itype(i))**2)
10565 IF (saxs_cutoff.eq.0) THEN
10568 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
10569 Pcalc(k) = Pcalc(k)+expCACA
10570 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
10572 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10573 PgradC(k,l,i) = PgradC(k,l,i)-aux
10574 PgradC(k,l,j) = PgradC(k,l,j)+aux
10578 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
10581 c write (2,*) "ijk",i,j,k
10582 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
10583 if (sss2.eq.0.0d0) cycle
10584 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
10585 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
10586 Pcalc(k) = Pcalc(k)+expCACA
10588 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
10590 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
10591 & ssgrad2*expCACA/sss2
10594 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
10595 PgradC(k,l,i) = PgradC(k,l,i)+aux
10596 PgradC(k,l,j) = PgradC(k,l,j)-aux
10605 if (nfgtasks.gt.1) then
10606 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
10607 & MPI_SUM,king,FG_COMM,IERR)
10608 if (fg_rank.eq.king) then
10610 Pcalc(k) = Pcalc_(k)
10613 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
10614 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10615 if (fg_rank.eq.king) then
10619 PgradC(k,l,i) = PgradC_(k,l,i)
10625 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
10626 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10627 if (fg_rank.eq.king) then
10631 PgradX(k,l,i) = PgradX_(k,l,i)
10640 if (fg_rank.eq.king) then
10644 Cnorm = Cnorm + Pcalc(k)
10646 Esaxs_constr = dlog(Cnorm)-wsaxs0
10648 if (Pcalc(k).gt.0.0d0)
10649 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
10651 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
10655 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
10665 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
10666 auxC1 = auxC1+PgradC(k,l,i)
10668 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
10669 auxX1 = auxX1+PgradX(k,l,i)
10672 gsaxsC(l,i) = auxC - auxC1/Cnorm
10674 gsaxsX(l,i) = auxX - auxX1/Cnorm
10676 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
10677 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
10685 c----------------------------------------------------------------------------
10686 subroutine e_saxsC(Esaxs_constr)
10688 include 'DIMENSIONS'
10689 include 'DIMENSIONS.ZSCOPT'
10690 include 'DIMENSIONS.FREE'
10693 include "COMMON.SETUP"
10696 include 'COMMON.SBRIDGE'
10697 include 'COMMON.CHAIN'
10698 include 'COMMON.GEO'
10699 include 'COMMON.LOCAL'
10700 include 'COMMON.INTERACT'
10701 include 'COMMON.VAR'
10702 include 'COMMON.IOUNITS'
10703 include 'COMMON.DERIV'
10704 include 'COMMON.CONTROL'
10705 include 'COMMON.NAMES'
10706 include 'COMMON.FFIELD'
10707 include 'COMMON.LANGEVIN'
10708 include 'COMMON.SAXS'
10710 double precision Esaxs_constr
10711 integer i,iint,j,k,l
10712 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
10714 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
10716 double precision dk,dijCASPH,dijSCSPH,
10717 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
10718 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
10720 c SAXS restraint penalty function
10722 write(iout,*) "------- SAXS penalty function start -------"
10723 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
10724 & " isaxs_end",isaxs_end
10725 write (iout,*) "nnt",nnt," ntc",nct
10727 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
10728 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
10731 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
10734 Esaxs_constr = 0.0d0
10736 do j=isaxs_start,isaxs_end
10748 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
10750 if (itype(i).ne.10) then
10752 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
10755 sigma2CA=2.0d0/pstok**2
10756 sigma2SC=4.0d0/restok(itype(i))**2
10757 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
10758 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
10759 Pcalc = Pcalc+expCASPH+expSCSPH
10761 write(*,*) "processor i j Pcalc",
10762 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
10764 CASPHgrad = sigma2CA*expCASPH
10765 SCSPHgrad = sigma2SC*expSCSPH
10767 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
10768 PgradX(l,i) = PgradX(l,i) + aux
10769 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
10774 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
10775 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
10778 logPtot = logPtot - dlog(Pcalc)
10779 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
10780 c & " logPtot",logPtot
10783 if (nfgtasks.gt.1) then
10784 c write (iout,*) "logPtot before reduction",logPtot
10785 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
10786 & MPI_SUM,king,FG_COMM,IERR)
10788 c write (iout,*) "logPtot after reduction",logPtot
10789 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
10790 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10791 if (fg_rank.eq.king) then
10794 gsaxsC(l,i) = gsaxsC_(l,i)
10798 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
10799 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10800 if (fg_rank.eq.king) then
10803 gsaxsX(l,i) = gsaxsX_(l,i)
10809 Esaxs_constr = logPtot