1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
15 include 'COMMON.FFIELD'
16 include 'COMMON.DERIV'
17 include 'COMMON.INTERACT'
18 include 'COMMON.SBRIDGE'
19 include 'COMMON.CHAIN'
20 include 'COMMON.SHIELD'
21 include 'COMMON.CONTROL'
22 include 'COMMON.TORCNSTR'
23 double precision fact(6)
24 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
26 cd print *,'nnt=',nnt,' nct=',nct
28 C Compute the side-chain and electrostatic interaction energy
30 goto (101,102,103,104,105) ipot
31 C Lennard-Jones potential.
32 101 call elj(evdw,evdw_t)
33 cd print '(a)','Exit ELJ'
35 C Lennard-Jones-Kihara potential (shifted).
36 102 call eljk(evdw,evdw_t)
38 C Berne-Pechukas potential (dilated LJ, angular dependence).
39 103 call ebp(evdw,evdw_t)
41 C Gay-Berne potential (shifted LJ, angular dependence).
42 104 call egb(evdw,evdw_t)
44 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
45 105 call egbv(evdw,evdw_t)
46 C write(iout,*) 'po elektostatyce'
48 C Calculate electrostatic (H-bonding) energy of the main chain.
52 if (shield_mode.eq.1) then
54 else if (shield_mode.eq.2) then
57 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
58 C write(iout,*) 'po eelec'
60 C Calculate excluded-volume interaction energy between peptide groups
63 call escp(evdw2,evdw2_14)
65 c Calculate the bond-stretching energy
69 C write (iout,*) "estr",estr
71 C Calculate the disulfide-bridge and other energy and the contributions
72 C from other distance constraints.
73 cd print *,'Calling EHPB'
75 cd print *,'EHPB exitted succesfully.'
77 C Calculate the virtual-bond-angle energy.
79 C print *,'Bend energy finished.'
81 if (tor_mode.eq.0) then
84 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
92 if (with_theta_constr) call etheta_constr(ethetacnstr)
93 c call ebend(ebe,ethetacnstr)
94 cd print *,'Bend energy finished.'
96 C Calculate the SC local energy.
99 C print *,'SCLOC energy finished.'
101 C Calculate the virtual-bond torsional energy.
103 if (wtor.gt.0.0d0) then
104 if (tor_mode.eq.0) then
105 call etor(etors,fact(1))
107 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
109 call etor_kcc(etors,fact(1))
115 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
116 c print *,"Processor",myrank," computed Utor"
118 C 6/23/01 Calculate double-torsional energy
120 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
121 call etor_d(etors_d,fact(2))
125 c print *,"Processor",myrank," computed Utord"
127 call eback_sc_corr(esccor)
129 if (wliptran.gt.0) then
130 call Eliptransfer(eliptran)
134 C 12/1/95 Multi-body terms
138 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
139 & .or. wturn6.gt.0.0d0) then
140 c write(iout,*)"calling multibody_eello"
141 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
142 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
143 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
150 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
151 c write (iout,*) "Calling multibody_hbond"
152 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
154 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
155 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
156 call e_saxs(Esaxs_constr)
157 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
158 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
159 call e_saxsC(Esaxs_constr)
160 c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr
165 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
167 if (shield_mode.gt.0) then
168 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
170 & +fact(1)*wvdwpp*evdw1
171 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
172 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
173 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
174 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
175 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
176 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr+wsaxs*esaxs_constr
177 & +wliptran*eliptran*esaxs_constr
179 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
181 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
182 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
183 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
184 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
185 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
186 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
187 & +wliptran*eliptran+wsaxs*esaxs_constr
190 if (shield_mode.gt.0) then
191 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
192 & +welec*fact(1)*(ees+evdw1)
193 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
194 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
195 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
196 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
197 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
198 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
199 & +wliptran*eliptran+wsaxs*esaxs_constr
201 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
202 & +welec*fact(1)*(ees+evdw1)
203 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
204 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
205 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
206 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
207 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
208 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
209 & +wliptran*eliptran+wsaxs*esaxs_constr
215 energia(2)=evdw2-evdw2_14
232 energia(8)=eello_turn3
233 energia(9)=eello_turn4
242 energia(20)=edihcnstr
244 energia(24)=ethetacnstr
246 energia(26)=esaxs_constr
250 if (isnan(etot).ne.0) energia(0)=1.0d+99
252 if (isnan(etot)) energia(0)=1.0d+99
257 idumm=proc_proc(etot,i)
259 call proc_proc(etot,i)
261 if(i.eq.1)energia(0)=1.0d+99
267 call enerprint(energia,fact)
271 C Sum up the components of the Cartesian gradient.
276 if (shield_mode.eq.0) then
277 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
278 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
280 & wstrain*ghpbc(j,i)+
281 & wcorr*fact(3)*gradcorr(j,i)+
282 & wel_loc*fact(2)*gel_loc(j,i)+
283 & wturn3*fact(2)*gcorr3_turn(j,i)+
284 & wturn4*fact(3)*gcorr4_turn(j,i)+
285 & wcorr5*fact(4)*gradcorr5(j,i)+
286 & wcorr6*fact(5)*gradcorr6(j,i)+
287 & wturn6*fact(5)*gcorr6_turn(j,i)+
288 & wsccor*fact(2)*gsccorc(j,i)
289 & +wliptran*gliptranc(j,i)
290 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
292 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
293 & wsccor*fact(2)*gsccorx(j,i)
294 & +wliptran*gliptranx(j,i)
296 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
297 & +fact(1)*wscp*gvdwc_scp(j,i)+
298 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
300 & wstrain*ghpbc(j,i)+
301 & wcorr*fact(3)*gradcorr(j,i)+
302 & wel_loc*fact(2)*gel_loc(j,i)+
303 & wturn3*fact(2)*gcorr3_turn(j,i)+
304 & wturn4*fact(3)*gcorr4_turn(j,i)+
305 & wcorr5*fact(4)*gradcorr5(j,i)+
306 & wcorr6*fact(5)*gradcorr6(j,i)+
307 & wturn6*fact(5)*gcorr6_turn(j,i)+
308 & wsccor*fact(2)*gsccorc(j,i)
309 & +wliptran*gliptranc(j,i)
310 & +welec*gshieldc(j,i)
311 & +welec*gshieldc_loc(j,i)
312 & +wcorr*gshieldc_ec(j,i)
313 & +wcorr*gshieldc_loc_ec(j,i)
314 & +wturn3*gshieldc_t3(j,i)
315 & +wturn3*gshieldc_loc_t3(j,i)
316 & +wturn4*gshieldc_t4(j,i)
317 & +wturn4*gshieldc_loc_t4(j,i)
318 & +wel_loc*gshieldc_ll(j,i)
319 & +wel_loc*gshieldc_loc_ll(j,i)
321 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
322 & +fact(1)*wscp*gradx_scp(j,i)+
324 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
325 & wsccor*fact(2)*gsccorx(j,i)
326 & +wliptran*gliptranx(j,i)
327 & +welec*gshieldx(j,i)
328 & +wcorr*gshieldx_ec(j,i)
329 & +wturn3*gshieldx_t3(j,i)
330 & +wturn4*gshieldx_t4(j,i)
331 & +wel_loc*gshieldx_ll(j,i)
339 if (shield_mode.eq.0) then
340 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
341 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
343 & wcorr*fact(3)*gradcorr(j,i)+
344 & wel_loc*fact(2)*gel_loc(j,i)+
345 & wturn3*fact(2)*gcorr3_turn(j,i)+
346 & wturn4*fact(3)*gcorr4_turn(j,i)+
347 & wcorr5*fact(4)*gradcorr5(j,i)+
348 & wcorr6*fact(5)*gradcorr6(j,i)+
349 & wturn6*fact(5)*gcorr6_turn(j,i)+
350 & wsccor*fact(2)*gsccorc(j,i)
351 & +wliptran*gliptranc(j,i)
352 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
354 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
355 & wsccor*fact(1)*gsccorx(j,i)
356 & +wliptran*gliptranx(j,i)
358 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
359 & fact(1)*wscp*gvdwc_scp(j,i)+
360 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
362 & wcorr*fact(3)*gradcorr(j,i)+
363 & wel_loc*fact(2)*gel_loc(j,i)+
364 & wturn3*fact(2)*gcorr3_turn(j,i)+
365 & wturn4*fact(3)*gcorr4_turn(j,i)+
366 & wcorr5*fact(4)*gradcorr5(j,i)+
367 & wcorr6*fact(5)*gradcorr6(j,i)+
368 & wturn6*fact(5)*gcorr6_turn(j,i)+
369 & wsccor*fact(2)*gsccorc(j,i)
370 & +wliptran*gliptranc(j,i)
371 & +welec*gshieldc(j,i)
372 & +welec*gshieldc_loc(j,i)
373 & +wcorr*gshieldc_ec(j,i)
374 & +wcorr*gshieldc_loc_ec(j,i)
375 & +wturn3*gshieldc_t3(j,i)
376 & +wturn3*gshieldc_loc_t3(j,i)
377 & +wturn4*gshieldc_t4(j,i)
378 & +wturn4*gshieldc_loc_t4(j,i)
379 & +wel_loc*gshieldc_ll(j,i)
380 & +wel_loc*gshieldc_loc_ll(j,i)
382 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
383 & fact(1)*wscp*gradx_scp(j,i)+
385 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
386 & wsccor*fact(1)*gsccorx(j,i)
387 & +wliptran*gliptranx(j,i)
388 & +welec*gshieldx(j,i)
389 & +wcorr*gshieldx_ec(j,i)
390 & +wturn3*gshieldx_t3(j,i)
391 & +wturn4*gshieldx_t4(j,i)
392 & +wel_loc*gshieldx_ll(j,i)
401 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
402 & +wcorr5*fact(4)*g_corr5_loc(i)
403 & +wcorr6*fact(5)*g_corr6_loc(i)
404 & +wturn4*fact(3)*gel_loc_turn4(i)
405 & +wturn3*fact(2)*gel_loc_turn3(i)
406 & +wturn6*fact(5)*gel_loc_turn6(i)
407 & +wel_loc*fact(2)*gel_loc_loc(i)
408 c & +wsccor*fact(1)*gsccor_loc(i)
409 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
412 if (dyn_ss) call dyn_set_nss
415 C------------------------------------------------------------------------
416 subroutine enerprint(energia,fact)
417 implicit real*8 (a-h,o-z)
419 include 'DIMENSIONS.ZSCOPT'
420 include 'COMMON.IOUNITS'
421 include 'COMMON.FFIELD'
422 include 'COMMON.SBRIDGE'
423 include 'COMMON.CONTROL'
424 double precision energia(0:max_ene),fact(6)
426 evdw=energia(1)+fact(6)*energia(21)
428 evdw2=energia(2)+energia(17)
440 eello_turn3=energia(8)
441 eello_turn4=energia(9)
442 eello_turn6=energia(10)
449 edihcnstr=energia(20)
451 ethetacnstr=energia(24)
455 if (shield_mode.gt.0) then
456 write (iout,10) evdw,wsc*fact(1),evdw2,wscp*fact(1),ees,
457 & welec*fact(1),evdw1,wvdwpp*fact(1),
458 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
459 & etors_d,wtor_d*fact(2),ehpb,wstrain,
460 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
461 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
462 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
463 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
464 & eliptran,wliptran,esaxs,wsaxs,etot
466 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
468 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
469 & etors_d,wtor_d*fact(2),ehpb,wstrain,
470 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
471 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
472 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
473 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
474 & eliptran,wliptran,esaxs,wsaxs,etot
476 10 format (/'Virtual-chain energies:'//
477 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
478 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
479 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
480 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
481 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
482 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
483 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
484 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
485 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
486 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
487 & ' (SS bridges & dist. cnstr.)'/
488 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
489 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
490 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
491 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
492 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
493 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
494 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
495 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
496 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
497 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
498 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
499 & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/
500 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/
501 & 'ETOT= ',1pE16.6,' (total)')
503 if (shield_mode.gt.0) then
504 write (iout,10) evdw,wsc*fact(1),evdw2,wscp*fact(2),ees,
505 & welec*fact(1),estr,wbond,
506 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
507 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
508 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
509 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
510 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
511 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,esaxs,wsaxs,etot
513 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
514 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
515 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
516 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
517 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
518 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
519 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,esaxs,wsaxs,etot
521 10 format (/'Virtual-chain energies:'//
522 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
523 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
524 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
525 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
526 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
527 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
528 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
529 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
530 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
531 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
532 & ' (SS bridges & dist. cnstr.)'/
533 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
534 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
535 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
536 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
537 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
538 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
539 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
540 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
541 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
542 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
543 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
544 & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/
545 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/
546 & 'ETOT= ',1pE16.6,' (total)')
550 C-----------------------------------------------------------------------
551 subroutine elj(evdw,evdw_t)
553 C This subroutine calculates the interaction energy of nonbonded side chains
554 C assuming the LJ potential of interaction.
556 implicit real*8 (a-h,o-z)
558 include 'DIMENSIONS.ZSCOPT'
559 include "DIMENSIONS.COMPAR"
560 parameter (accur=1.0d-10)
563 include 'COMMON.LOCAL'
564 include 'COMMON.CHAIN'
565 include 'COMMON.DERIV'
566 include 'COMMON.INTERACT'
567 include 'COMMON.TORSION'
568 include 'COMMON.ENEPS'
569 include 'COMMON.SBRIDGE'
570 include 'COMMON.NAMES'
571 include 'COMMON.IOUNITS'
572 include 'COMMON.CONTACTS'
576 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
580 eneps_temp(j,i)=0.0d0
589 if (itypi.eq.ntyp1) cycle
590 itypi1=iabs(itype(i+1))
597 C Calculate SC interaction energy.
600 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
601 cd & 'iend=',iend(i,iint)
602 do j=istart(i,iint),iend(i,iint)
604 if (itypj.eq.ntyp1) cycle
608 C Change 12/1/95 to calculate four-body interactions
609 rij=xj*xj+yj*yj+zj*zj
611 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
612 eps0ij=eps(itypi,itypj)
617 ij=icant(itypi,itypj)
619 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
620 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
623 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
624 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
625 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
626 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
627 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
628 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
629 if (bb.gt.0.0d0) then
636 C Calculate the components of the gradient in DC and X
638 fac=-rrij*(e1+evdwij)
643 gvdwx(k,i)=gvdwx(k,i)-gg(k)
644 gvdwx(k,j)=gvdwx(k,j)+gg(k)
648 gvdwc(l,k)=gvdwc(l,k)+gg(l)
653 C 12/1/95, revised on 5/20/97
655 C Calculate the contact function. The ith column of the array JCONT will
656 C contain the numbers of atoms that make contacts with the atom I (of numbers
657 C greater than I). The arrays FACONT and GACONT will contain the values of
658 C the contact function and its derivative.
660 C Uncomment next line, if the correlation interactions include EVDW explicitly.
661 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
662 C Uncomment next line, if the correlation interactions are contact function only
663 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
665 sigij=sigma(itypi,itypj)
666 r0ij=rs0(itypi,itypj)
668 C Check whether the SC's are not too far to make a contact.
671 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
672 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
674 if (fcont.gt.0.0D0) then
675 C If the SC-SC distance if close to sigma, apply spline.
676 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
677 cAdam & fcont1,fprimcont1)
678 cAdam fcont1=1.0d0-fcont1
679 cAdam if (fcont1.gt.0.0d0) then
680 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
681 cAdam fcont=fcont*fcont1
683 C Uncomment following 4 lines to have the geometric average of the epsilon0's
684 cga eps0ij=1.0d0/dsqrt(eps0ij)
686 cga gg(k)=gg(k)*eps0ij
688 cga eps0ij=-evdwij*eps0ij
689 C Uncomment for AL's type of SC correlation interactions.
691 num_conti=num_conti+1
693 facont(num_conti,i)=fcont*eps0ij
694 fprimcont=eps0ij*fprimcont/rij
696 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
697 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
698 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
699 C Uncomment following 3 lines for Skolnick's type of SC correlation.
700 gacont(1,num_conti,i)=-fprimcont*xj
701 gacont(2,num_conti,i)=-fprimcont*yj
702 gacont(3,num_conti,i)=-fprimcont*zj
703 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
704 cd write (iout,'(2i3,3f10.5)')
705 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
711 num_cont(i)=num_conti
716 gvdwc(j,i)=expon*gvdwc(j,i)
717 gvdwx(j,i)=expon*gvdwx(j,i)
721 C******************************************************************************
725 C To save time, the factor of EXPON has been extracted from ALL components
726 C of GVDWC and GRADX. Remember to multiply them by this factor before further
729 C******************************************************************************
732 C-----------------------------------------------------------------------------
733 subroutine eljk(evdw,evdw_t)
735 C This subroutine calculates the interaction energy of nonbonded side chains
736 C assuming the LJK potential of interaction.
738 implicit real*8 (a-h,o-z)
740 include 'DIMENSIONS.ZSCOPT'
741 include "DIMENSIONS.COMPAR"
744 include 'COMMON.LOCAL'
745 include 'COMMON.CHAIN'
746 include 'COMMON.DERIV'
747 include 'COMMON.INTERACT'
748 include 'COMMON.ENEPS'
749 include 'COMMON.IOUNITS'
750 include 'COMMON.NAMES'
755 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
758 eneps_temp(j,i)=0.0d0
765 if (itypi.eq.ntyp1) cycle
766 itypi1=iabs(itype(i+1))
771 C Calculate SC interaction energy.
774 do j=istart(i,iint),iend(i,iint)
776 if (itypj.eq.ntyp1) cycle
780 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
782 e_augm=augm(itypi,itypj)*fac_augm
785 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
786 fac=r_shift_inv**expon
790 ij=icant(itypi,itypj)
791 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
792 & /dabs(eps(itypi,itypj))
793 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
794 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
795 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
796 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
797 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
798 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
799 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
800 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
801 if (bb.gt.0.0d0) then
808 C Calculate the components of the gradient in DC and X
810 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
815 gvdwx(k,i)=gvdwx(k,i)-gg(k)
816 gvdwx(k,j)=gvdwx(k,j)+gg(k)
820 gvdwc(l,k)=gvdwc(l,k)+gg(l)
830 gvdwc(j,i)=expon*gvdwc(j,i)
831 gvdwx(j,i)=expon*gvdwx(j,i)
837 C-----------------------------------------------------------------------------
838 subroutine ebp(evdw,evdw_t)
840 C This subroutine calculates the interaction energy of nonbonded side chains
841 C assuming the Berne-Pechukas potential of interaction.
843 implicit real*8 (a-h,o-z)
845 include 'DIMENSIONS.ZSCOPT'
846 include "DIMENSIONS.COMPAR"
849 include 'COMMON.LOCAL'
850 include 'COMMON.CHAIN'
851 include 'COMMON.DERIV'
852 include 'COMMON.NAMES'
853 include 'COMMON.INTERACT'
854 include 'COMMON.ENEPS'
855 include 'COMMON.IOUNITS'
856 include 'COMMON.CALC'
858 c double precision rrsave(maxdim)
864 eneps_temp(j,i)=0.0d0
869 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
870 c if (icall.eq.0) then
878 if (itypi.eq.ntyp1) cycle
879 itypi1=iabs(itype(i+1))
883 dxi=dc_norm(1,nres+i)
884 dyi=dc_norm(2,nres+i)
885 dzi=dc_norm(3,nres+i)
886 dsci_inv=vbld_inv(i+nres)
888 C Calculate SC interaction energy.
891 do j=istart(i,iint),iend(i,iint)
894 if (itypj.eq.ntyp1) cycle
895 dscj_inv=vbld_inv(j+nres)
896 chi1=chi(itypi,itypj)
897 chi2=chi(itypj,itypi)
904 alf12=0.5D0*(alf1+alf2)
905 C For diagnostics only!!!
918 dxj=dc_norm(1,nres+j)
919 dyj=dc_norm(2,nres+j)
920 dzj=dc_norm(3,nres+j)
921 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
922 cd if (icall.eq.0) then
928 C Calculate the angle-dependent terms of energy & contributions to derivatives.
930 C Calculate whole angle-dependent part of epsilon and contributions
932 fac=(rrij*sigsq)**expon2
935 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
936 eps2der=evdwij*eps3rt
937 eps3der=evdwij*eps2rt
938 evdwij=evdwij*eps2rt*eps3rt
939 ij=icant(itypi,itypj)
940 aux=eps1*eps2rt**2*eps3rt**2
941 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
942 & /dabs(eps(itypi,itypj))
943 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
944 if (bb.gt.0.0d0) then
951 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
953 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
954 & restyp(itypi),i,restyp(itypj),j,
955 & epsi,sigm,chi1,chi2,chip1,chip2,
956 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
957 & om1,om2,om12,1.0D0/dsqrt(rrij),
960 C Calculate gradient components.
961 e1=e1*eps1*eps2rt**2*eps3rt**2
962 fac=-expon*(e1+evdwij)
965 C Calculate radial part of the gradient
969 C Calculate the angular part of the gradient and sum add the contributions
970 C to the appropriate components of the Cartesian gradient.
979 C-----------------------------------------------------------------------------
980 subroutine egb(evdw,evdw_t)
982 C This subroutine calculates the interaction energy of nonbonded side chains
983 C assuming the Gay-Berne potential of interaction.
985 implicit real*8 (a-h,o-z)
987 include 'DIMENSIONS.ZSCOPT'
988 include "DIMENSIONS.COMPAR"
989 include 'COMMON.CONTROL'
992 include 'COMMON.LOCAL'
993 include 'COMMON.CHAIN'
994 include 'COMMON.DERIV'
995 include 'COMMON.NAMES'
996 include 'COMMON.INTERACT'
997 include 'COMMON.ENEPS'
998 include 'COMMON.IOUNITS'
999 include 'COMMON.CALC'
1000 include 'COMMON.SBRIDGE'
1003 integer icant,xshift,yshift,zshift
1007 eneps_temp(j,i)=0.0d0
1010 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1014 c if (icall.gt.0) lprn=.true.
1016 do i=iatsc_s,iatsc_e
1017 itypi=iabs(itype(i))
1018 if (itypi.eq.ntyp1) cycle
1019 itypi1=iabs(itype(i+1))
1023 C returning the ith atom to box
1025 if (xi.lt.0) xi=xi+boxxsize
1027 if (yi.lt.0) yi=yi+boxysize
1029 if (zi.lt.0) zi=zi+boxzsize
1030 if ((zi.gt.bordlipbot)
1031 &.and.(zi.lt.bordliptop)) then
1032 C the energy transfer exist
1033 if (zi.lt.buflipbot) then
1034 C what fraction I am in
1036 & ((zi-bordlipbot)/lipbufthick)
1037 C lipbufthick is thickenes of lipid buffore
1038 sslipi=sscalelip(fracinbuf)
1039 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1040 elseif (zi.gt.bufliptop) then
1041 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1042 sslipi=sscalelip(fracinbuf)
1043 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1053 dxi=dc_norm(1,nres+i)
1054 dyi=dc_norm(2,nres+i)
1055 dzi=dc_norm(3,nres+i)
1056 dsci_inv=vbld_inv(i+nres)
1058 C Calculate SC interaction energy.
1060 do iint=1,nint_gr(i)
1061 do j=istart(i,iint),iend(i,iint)
1062 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1063 call dyn_ssbond_ene(i,j,evdwij)
1065 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1066 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1067 C triple bond artifac removal
1068 do k=j+1,iend(i,iint)
1069 C search over all next residues
1070 if (dyn_ss_mask(k)) then
1071 C check if they are cysteins
1072 C write(iout,*) 'k=',k
1073 call triple_ssbond_ene(i,j,k,evdwij)
1074 C call the energy function that removes the artifical triple disulfide
1075 C bond the soubroutine is located in ssMD.F
1077 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1078 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1079 endif!dyn_ss_mask(k)
1083 itypj=iabs(itype(j))
1084 if (itypj.eq.ntyp1) cycle
1085 dscj_inv=vbld_inv(j+nres)
1086 sig0ij=sigma(itypi,itypj)
1087 chi1=chi(itypi,itypj)
1088 chi2=chi(itypj,itypi)
1095 alf12=0.5D0*(alf1+alf2)
1096 C For diagnostics only!!!
1109 C returning jth atom to box
1111 if (xj.lt.0) xj=xj+boxxsize
1113 if (yj.lt.0) yj=yj+boxysize
1115 if (zj.lt.0) zj=zj+boxzsize
1116 if ((zj.gt.bordlipbot)
1117 &.and.(zj.lt.bordliptop)) then
1118 C the energy transfer exist
1119 if (zj.lt.buflipbot) then
1120 C what fraction I am in
1122 & ((zj-bordlipbot)/lipbufthick)
1123 C lipbufthick is thickenes of lipid buffore
1124 sslipj=sscalelip(fracinbuf)
1125 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1126 elseif (zj.gt.bufliptop) then
1127 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1128 sslipj=sscalelip(fracinbuf)
1129 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1138 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1139 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1140 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1141 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1142 C if (aa.ne.aa_aq(itypi,itypj)) then
1144 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1145 C & bb_aq(itypi,itypj)-bb,
1149 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1150 C checking the distance
1151 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1156 C finding the closest
1160 xj=xj_safe+xshift*boxxsize
1161 yj=yj_safe+yshift*boxysize
1162 zj=zj_safe+zshift*boxzsize
1163 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1164 if(dist_temp.lt.dist_init) then
1174 if (subchap.eq.1) then
1184 dxj=dc_norm(1,nres+j)
1185 dyj=dc_norm(2,nres+j)
1186 dzj=dc_norm(3,nres+j)
1187 c write (iout,*) i,j,xj,yj,zj
1188 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1190 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1191 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1192 if (sss.le.0.0) cycle
1193 C Calculate angle-dependent terms of energy and contributions to their
1198 sig=sig0ij*dsqrt(sigsq)
1199 rij_shift=1.0D0/rij-sig+sig0ij
1200 C I hate to put IF's in the loops, but here don't have another choice!!!!
1201 if (rij_shift.le.0.0D0) then
1206 c---------------------------------------------------------------
1207 rij_shift=1.0D0/rij_shift
1208 fac=rij_shift**expon
1211 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1212 eps2der=evdwij*eps3rt
1213 eps3der=evdwij*eps2rt
1214 evdwij=evdwij*eps2rt*eps3rt
1216 evdw=evdw+evdwij*sss
1218 evdw_t=evdw_t+evdwij*sss
1220 ij=icant(itypi,itypj)
1221 aux=eps1*eps2rt**2*eps3rt**2
1222 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1223 & /dabs(eps(itypi,itypj))
1224 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1225 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1226 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1227 c & aux*e2/eps(itypi,itypj)
1229 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1233 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1234 & restyp(itypi),i,restyp(itypj),j,
1235 & epsi,sigm,chi1,chi2,chip1,chip2,
1236 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1237 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1239 write (iout,*) "partial sum", evdw, evdw_t
1243 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1246 C Calculate gradient components.
1247 e1=e1*eps1*eps2rt**2*eps3rt**2
1248 fac=-expon*(e1+evdwij)*rij_shift
1251 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1252 C Calculate the radial part of the gradient
1256 C Calculate angular part of the gradient.
1259 C write(iout,*) "partial sum", evdw, evdw_t
1266 C-----------------------------------------------------------------------------
1267 subroutine egbv(evdw,evdw_t)
1269 C This subroutine calculates the interaction energy of nonbonded side chains
1270 C assuming the Gay-Berne-Vorobjev potential of interaction.
1272 implicit real*8 (a-h,o-z)
1273 include 'DIMENSIONS'
1274 include 'DIMENSIONS.ZSCOPT'
1275 include "DIMENSIONS.COMPAR"
1276 include 'COMMON.GEO'
1277 include 'COMMON.VAR'
1278 include 'COMMON.LOCAL'
1279 include 'COMMON.CHAIN'
1280 include 'COMMON.DERIV'
1281 include 'COMMON.NAMES'
1282 include 'COMMON.INTERACT'
1283 include 'COMMON.ENEPS'
1284 include 'COMMON.IOUNITS'
1285 include 'COMMON.CALC'
1286 common /srutu/ icall
1292 eneps_temp(j,i)=0.0d0
1297 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1300 c if (icall.gt.0) lprn=.true.
1302 do i=iatsc_s,iatsc_e
1303 itypi=iabs(itype(i))
1304 if (itypi.eq.ntyp1) cycle
1305 itypi1=iabs(itype(i+1))
1309 dxi=dc_norm(1,nres+i)
1310 dyi=dc_norm(2,nres+i)
1311 dzi=dc_norm(3,nres+i)
1312 dsci_inv=vbld_inv(i+nres)
1314 C Calculate SC interaction energy.
1316 do iint=1,nint_gr(i)
1317 do j=istart(i,iint),iend(i,iint)
1319 itypj=iabs(itype(j))
1320 if (itypj.eq.ntyp1) cycle
1321 dscj_inv=vbld_inv(j+nres)
1322 sig0ij=sigma(itypi,itypj)
1323 r0ij=r0(itypi,itypj)
1324 chi1=chi(itypi,itypj)
1325 chi2=chi(itypj,itypi)
1332 alf12=0.5D0*(alf1+alf2)
1333 C For diagnostics only!!!
1346 dxj=dc_norm(1,nres+j)
1347 dyj=dc_norm(2,nres+j)
1348 dzj=dc_norm(3,nres+j)
1349 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1351 C Calculate angle-dependent terms of energy and contributions to their
1355 sig=sig0ij*dsqrt(sigsq)
1356 rij_shift=1.0D0/rij-sig+r0ij
1357 C I hate to put IF's in the loops, but here don't have another choice!!!!
1358 if (rij_shift.le.0.0D0) then
1363 c---------------------------------------------------------------
1364 rij_shift=1.0D0/rij_shift
1365 fac=rij_shift**expon
1368 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1369 eps2der=evdwij*eps3rt
1370 eps3der=evdwij*eps2rt
1371 fac_augm=rrij**expon
1372 e_augm=augm(itypi,itypj)*fac_augm
1373 evdwij=evdwij*eps2rt*eps3rt
1374 if (bb.gt.0.0d0) then
1375 evdw=evdw+evdwij+e_augm
1377 evdw_t=evdw_t+evdwij+e_augm
1379 ij=icant(itypi,itypj)
1380 aux=eps1*eps2rt**2*eps3rt**2
1381 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1382 & /dabs(eps(itypi,itypj))
1383 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1384 c eneps_temp(ij)=eneps_temp(ij)
1385 c & +(evdwij+e_augm)/eps(itypi,itypj)
1387 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1388 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1389 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1390 c & restyp(itypi),i,restyp(itypj),j,
1391 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1392 c & chi1,chi2,chip1,chip2,
1393 c & eps1,eps2rt**2,eps3rt**2,
1394 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1398 C Calculate gradient components.
1399 e1=e1*eps1*eps2rt**2*eps3rt**2
1400 fac=-expon*(e1+evdwij)*rij_shift
1402 fac=rij*fac-2*expon*rrij*e_augm
1403 C Calculate the radial part of the gradient
1407 C Calculate angular part of the gradient.
1415 C-----------------------------------------------------------------------------
1416 subroutine sc_angular
1417 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1418 C om12. Called by ebp, egb, and egbv.
1420 include 'COMMON.CALC'
1424 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1425 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1426 om12=dxi*dxj+dyi*dyj+dzi*dzj
1428 C Calculate eps1(om12) and its derivative in om12
1429 faceps1=1.0D0-om12*chiom12
1430 faceps1_inv=1.0D0/faceps1
1431 eps1=dsqrt(faceps1_inv)
1432 C Following variable is eps1*deps1/dom12
1433 eps1_om12=faceps1_inv*chiom12
1434 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1439 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1440 sigsq=1.0D0-facsig*faceps1_inv
1441 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1442 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1443 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1444 C Calculate eps2 and its derivatives in om1, om2, and om12.
1447 chipom12=chip12*om12
1448 facp=1.0D0-om12*chipom12
1450 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1451 C Following variable is the square root of eps2
1452 eps2rt=1.0D0-facp1*facp_inv
1453 C Following three variables are the derivatives of the square root of eps
1454 C in om1, om2, and om12.
1455 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1456 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1457 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1458 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1459 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1460 C Calculate whole angle-dependent part of epsilon and contributions
1461 C to its derivatives
1464 C----------------------------------------------------------------------------
1466 implicit real*8 (a-h,o-z)
1467 include 'DIMENSIONS'
1468 include 'DIMENSIONS.ZSCOPT'
1469 include 'COMMON.CHAIN'
1470 include 'COMMON.DERIV'
1471 include 'COMMON.CALC'
1472 double precision dcosom1(3),dcosom2(3)
1473 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1474 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1475 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1476 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1478 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1479 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1482 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1485 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1486 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1487 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1488 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1489 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1490 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1493 C Calculate the components of the gradient in DC and X
1497 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1502 c------------------------------------------------------------------------------
1503 subroutine vec_and_deriv
1504 implicit real*8 (a-h,o-z)
1505 include 'DIMENSIONS'
1506 include 'DIMENSIONS.ZSCOPT'
1507 include 'COMMON.IOUNITS'
1508 include 'COMMON.GEO'
1509 include 'COMMON.VAR'
1510 include 'COMMON.LOCAL'
1511 include 'COMMON.CHAIN'
1512 include 'COMMON.VECTORS'
1513 include 'COMMON.DERIV'
1514 include 'COMMON.INTERACT'
1515 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1516 C Compute the local reference systems. For reference system (i), the
1517 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1518 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1520 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1521 if (i.eq.nres-1) then
1522 C Case of the last full residue
1523 C Compute the Z-axis
1524 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1525 costh=dcos(pi-theta(nres))
1526 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1527 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1533 C Compute the derivatives of uz
1535 uzder(2,1,1)=-dc_norm(3,i-1)
1536 uzder(3,1,1)= dc_norm(2,i-1)
1537 uzder(1,2,1)= dc_norm(3,i-1)
1539 uzder(3,2,1)=-dc_norm(1,i-1)
1540 uzder(1,3,1)=-dc_norm(2,i-1)
1541 uzder(2,3,1)= dc_norm(1,i-1)
1544 uzder(2,1,2)= dc_norm(3,i)
1545 uzder(3,1,2)=-dc_norm(2,i)
1546 uzder(1,2,2)=-dc_norm(3,i)
1548 uzder(3,2,2)= dc_norm(1,i)
1549 uzder(1,3,2)= dc_norm(2,i)
1550 uzder(2,3,2)=-dc_norm(1,i)
1553 C Compute the Y-axis
1556 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1559 C Compute the derivatives of uy
1562 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1563 & -dc_norm(k,i)*dc_norm(j,i-1)
1564 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1566 uyder(j,j,1)=uyder(j,j,1)-costh
1567 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1572 uygrad(l,k,j,i)=uyder(l,k,j)
1573 uzgrad(l,k,j,i)=uzder(l,k,j)
1577 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1578 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1579 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1580 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1584 C Compute the Z-axis
1585 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1586 costh=dcos(pi-theta(i+2))
1587 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1592 C Compute the derivatives of uz
1594 uzder(2,1,1)=-dc_norm(3,i+1)
1595 uzder(3,1,1)= dc_norm(2,i+1)
1596 uzder(1,2,1)= dc_norm(3,i+1)
1598 uzder(3,2,1)=-dc_norm(1,i+1)
1599 uzder(1,3,1)=-dc_norm(2,i+1)
1600 uzder(2,3,1)= dc_norm(1,i+1)
1603 uzder(2,1,2)= dc_norm(3,i)
1604 uzder(3,1,2)=-dc_norm(2,i)
1605 uzder(1,2,2)=-dc_norm(3,i)
1607 uzder(3,2,2)= dc_norm(1,i)
1608 uzder(1,3,2)= dc_norm(2,i)
1609 uzder(2,3,2)=-dc_norm(1,i)
1612 C Compute the Y-axis
1615 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1618 C Compute the derivatives of uy
1621 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1622 & -dc_norm(k,i)*dc_norm(j,i+1)
1623 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1625 uyder(j,j,1)=uyder(j,j,1)-costh
1626 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1631 uygrad(l,k,j,i)=uyder(l,k,j)
1632 uzgrad(l,k,j,i)=uzder(l,k,j)
1636 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1637 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1638 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1639 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1645 vbld_inv_temp(1)=vbld_inv(i+1)
1646 if (i.lt.nres-1) then
1647 vbld_inv_temp(2)=vbld_inv(i+2)
1649 vbld_inv_temp(2)=vbld_inv(i)
1654 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1655 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1663 C--------------------------------------------------------------------------
1664 subroutine set_matrices
1665 implicit real*8 (a-h,o-z)
1666 include 'DIMENSIONS'
1670 integer status(MPI_STATUS_SIZE)
1672 include 'DIMENSIONS.ZSCOPT'
1673 include 'COMMON.IOUNITS'
1674 include 'COMMON.GEO'
1675 include 'COMMON.VAR'
1676 include 'COMMON.LOCAL'
1677 include 'COMMON.CHAIN'
1678 include 'COMMON.DERIV'
1679 include 'COMMON.INTERACT'
1680 include 'COMMON.CONTACTS'
1681 include 'COMMON.TORSION'
1682 include 'COMMON.VECTORS'
1683 include 'COMMON.FFIELD'
1684 double precision auxvec(2),auxmat(2,2)
1686 C Compute the virtual-bond-torsional-angle dependent quantities needed
1687 C to calculate the el-loc multibody terms of various order.
1689 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1691 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1692 iti = itype2loc(itype(i-2))
1696 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1697 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1698 iti1 = itype2loc(itype(i-1))
1703 cost1=dcos(theta(i-1))
1704 sint1=dsin(theta(i-1))
1706 sint1cub=sint1sq*sint1
1707 sint1cost1=2*sint1*cost1
1709 write (iout,*) "bnew1",i,iti
1710 write (iout,*) (bnew1(k,1,iti),k=1,3)
1711 write (iout,*) (bnew1(k,2,iti),k=1,3)
1712 write (iout,*) "bnew2",i,iti
1713 write (iout,*) (bnew2(k,1,iti),k=1,3)
1714 write (iout,*) (bnew2(k,2,iti),k=1,3)
1717 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1719 gtb1(k,i-2)=cost1*b1k-sint1sq*
1720 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1721 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1723 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1724 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1727 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1728 cc(1,k,i-2)=sint1sq*aux
1729 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1730 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1731 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1732 dd(1,k,i-2)=sint1sq*aux
1733 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1734 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1736 cc(2,1,i-2)=cc(1,2,i-2)
1737 cc(2,2,i-2)=-cc(1,1,i-2)
1738 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1739 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1740 dd(2,1,i-2)=dd(1,2,i-2)
1741 dd(2,2,i-2)=-dd(1,1,i-2)
1742 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1743 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1746 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1747 EE(l,k,i-2)=sint1sq*aux
1749 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1752 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1753 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1754 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1755 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1757 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1758 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1759 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1761 c b1tilde(1,i-2)=b1(1,i-2)
1762 c b1tilde(2,i-2)=-b1(2,i-2)
1763 c b2tilde(1,i-2)=b2(1,i-2)
1764 c b2tilde(2,i-2)=-b2(2,i-2)
1766 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1767 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1768 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1769 write (iout,*) 'theta=', theta(i-1)
1772 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1773 c iti = itype2loc(itype(i-2))
1777 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1778 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1779 c iti1 = itype2loc(itype(i-1))
1789 CC(k,l,i-2)=ccold(k,l,iti)
1790 DD(k,l,i-2)=ddold(k,l,iti)
1791 EE(k,l,i-2)=eeold(k,l,iti)
1795 b1tilde(1,i-2)= b1(1,i-2)
1796 b1tilde(2,i-2)=-b1(2,i-2)
1797 b2tilde(1,i-2)= b2(1,i-2)
1798 b2tilde(2,i-2)=-b2(2,i-2)
1800 Ctilde(1,1,i-2)= CC(1,1,i-2)
1801 Ctilde(1,2,i-2)= CC(1,2,i-2)
1802 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1803 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1805 Dtilde(1,1,i-2)= DD(1,1,i-2)
1806 Dtilde(1,2,i-2)= DD(1,2,i-2)
1807 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1808 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1810 write(iout,*) "i",i," iti",iti
1811 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1812 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1816 if (i .lt. nres+1) then
1853 if (i .gt. 3 .and. i .lt. nres+1) then
1854 obrot_der(1,i-2)=-sin1
1855 obrot_der(2,i-2)= cos1
1856 Ugder(1,1,i-2)= sin1
1857 Ugder(1,2,i-2)=-cos1
1858 Ugder(2,1,i-2)=-cos1
1859 Ugder(2,2,i-2)=-sin1
1862 obrot2_der(1,i-2)=-dwasin2
1863 obrot2_der(2,i-2)= dwacos2
1864 Ug2der(1,1,i-2)= dwasin2
1865 Ug2der(1,2,i-2)=-dwacos2
1866 Ug2der(2,1,i-2)=-dwacos2
1867 Ug2der(2,2,i-2)=-dwasin2
1869 obrot_der(1,i-2)=0.0d0
1870 obrot_der(2,i-2)=0.0d0
1871 Ugder(1,1,i-2)=0.0d0
1872 Ugder(1,2,i-2)=0.0d0
1873 Ugder(2,1,i-2)=0.0d0
1874 Ugder(2,2,i-2)=0.0d0
1875 obrot2_der(1,i-2)=0.0d0
1876 obrot2_der(2,i-2)=0.0d0
1877 Ug2der(1,1,i-2)=0.0d0
1878 Ug2der(1,2,i-2)=0.0d0
1879 Ug2der(2,1,i-2)=0.0d0
1880 Ug2der(2,2,i-2)=0.0d0
1882 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1883 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1884 iti = itype2loc(itype(i-2))
1888 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1889 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1890 iti1 = itype2loc(itype(i-1))
1894 cd write (iout,*) '*******i',i,' iti1',iti
1895 cd write (iout,*) 'b1',b1(:,iti)
1896 cd write (iout,*) 'b2',b2(:,iti)
1897 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1898 c if (i .gt. iatel_s+2) then
1899 if (i .gt. nnt+2) then
1900 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1902 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1903 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1905 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1906 c & EE(1,2,iti),EE(2,2,i)
1907 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1908 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1909 c write(iout,*) "Macierz EUG",
1910 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
1912 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
1914 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
1915 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
1916 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1917 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
1918 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
1929 DtUg2(l,k,i-2)=0.0d0
1933 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
1934 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
1936 muder(k,i-2)=Ub2der(k,i-2)
1938 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1939 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1940 if (itype(i-1).le.ntyp) then
1941 iti1 = itype2loc(itype(i-1))
1949 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
1952 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
1953 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
1954 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
1955 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
1956 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
1957 & ((ee(l,k,i-2),l=1,2),k=1,2)
1959 cd write (iout,*) 'mu1',mu1(:,i-2)
1960 cd write (iout,*) 'mu2',mu2(:,i-2)
1961 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
1964 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1965 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
1966 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1967 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
1968 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1970 C Vectors and matrices dependent on a single virtual-bond dihedral.
1971 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
1972 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1973 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
1974 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
1975 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
1977 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1978 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
1979 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
1980 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
1984 C Matrices dependent on two consecutive virtual-bond dihedrals.
1985 C The order of matrices is from left to right.
1986 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
1989 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1991 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1992 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1994 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1995 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1997 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1998 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1999 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2005 C--------------------------------------------------------------------------
2006 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2008 C This subroutine calculates the average interaction energy and its gradient
2009 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2010 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2011 C The potential depends both on the distance of peptide-group centers and on
2012 C the orientation of the CA-CA virtual bonds.
2014 implicit real*8 (a-h,o-z)
2018 include 'DIMENSIONS'
2019 include 'DIMENSIONS.ZSCOPT'
2020 include 'COMMON.CONTROL'
2021 include 'COMMON.IOUNITS'
2022 include 'COMMON.GEO'
2023 include 'COMMON.VAR'
2024 include 'COMMON.LOCAL'
2025 include 'COMMON.CHAIN'
2026 include 'COMMON.DERIV'
2027 include 'COMMON.INTERACT'
2028 include 'COMMON.CONTACTS'
2029 include 'COMMON.TORSION'
2030 include 'COMMON.VECTORS'
2031 include 'COMMON.FFIELD'
2032 include 'COMMON.TIME1'
2033 include 'COMMON.SPLITELE'
2034 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2035 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2036 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2037 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2038 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2039 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2041 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2043 double precision scal_el /1.0d0/
2045 double precision scal_el /0.5d0/
2048 C 13-go grudnia roku pamietnego...
2049 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2050 & 0.0d0,1.0d0,0.0d0,
2051 & 0.0d0,0.0d0,1.0d0/
2052 cd write(iout,*) 'In EELEC'
2054 cd write(iout,*) 'Type',i
2055 cd write(iout,*) 'B1',B1(:,i)
2056 cd write(iout,*) 'B2',B2(:,i)
2057 cd write(iout,*) 'CC',CC(:,:,i)
2058 cd write(iout,*) 'DD',DD(:,:,i)
2059 cd write(iout,*) 'EE',EE(:,:,i)
2061 cd call check_vecgrad
2063 if (icheckgrad.eq.1) then
2065 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2067 dc_norm(k,i)=dc(k,i)*fac
2069 c write (iout,*) 'i',i,' fac',fac
2072 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2073 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2074 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2075 c call vec_and_deriv
2081 time_mat=time_mat+MPI_Wtime()-time01
2085 cd write (iout,*) 'i=',i
2087 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2090 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2091 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2104 cd print '(a)','Enter EELEC'
2105 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2107 gel_loc_loc(i)=0.0d0
2112 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2114 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2116 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2117 do i=iturn3_start,iturn3_end
2119 C write(iout,*) "tu jest i",i
2120 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2121 C changes suggested by Ana to avoid out of bounds
2122 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2123 c & .or.((i+4).gt.nres)
2124 c & .or.((i-1).le.0)
2125 C end of changes by Ana
2126 C dobra zmiana wycofana
2127 & .or. itype(i+2).eq.ntyp1
2128 & .or. itype(i+3).eq.ntyp1) cycle
2129 C Adam: Instructions below will switch off existing interactions
2131 c if(itype(i-1).eq.ntyp1)cycle
2133 c if(i.LT.nres-3)then
2134 c if (itype(i+4).eq.ntyp1) cycle
2139 dx_normi=dc_norm(1,i)
2140 dy_normi=dc_norm(2,i)
2141 dz_normi=dc_norm(3,i)
2142 xmedi=c(1,i)+0.5d0*dxi
2143 ymedi=c(2,i)+0.5d0*dyi
2144 zmedi=c(3,i)+0.5d0*dzi
2145 xmedi=mod(xmedi,boxxsize)
2146 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2147 ymedi=mod(ymedi,boxysize)
2148 if (ymedi.lt.0) ymedi=ymedi+boxysize
2149 zmedi=mod(zmedi,boxzsize)
2150 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2152 call eelecij(i,i+2,ees,evdw1,eel_loc)
2153 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2154 num_cont_hb(i)=num_conti
2156 do i=iturn4_start,iturn4_end
2158 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2159 C changes suggested by Ana to avoid out of bounds
2160 c & .or.((i+5).gt.nres)
2161 c & .or.((i-1).le.0)
2162 C end of changes suggested by Ana
2163 & .or. itype(i+3).eq.ntyp1
2164 & .or. itype(i+4).eq.ntyp1
2165 c & .or. itype(i+5).eq.ntyp1
2166 c & .or. itype(i).eq.ntyp1
2167 c & .or. itype(i-1).eq.ntyp1
2172 dx_normi=dc_norm(1,i)
2173 dy_normi=dc_norm(2,i)
2174 dz_normi=dc_norm(3,i)
2175 xmedi=c(1,i)+0.5d0*dxi
2176 ymedi=c(2,i)+0.5d0*dyi
2177 zmedi=c(3,i)+0.5d0*dzi
2178 C Return atom into box, boxxsize is size of box in x dimension
2180 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2181 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2182 C Condition for being inside the proper box
2183 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2184 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2188 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2189 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2190 C Condition for being inside the proper box
2191 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2192 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2196 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2197 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2198 C Condition for being inside the proper box
2199 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2200 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2203 xmedi=mod(xmedi,boxxsize)
2204 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2205 ymedi=mod(ymedi,boxysize)
2206 if (ymedi.lt.0) ymedi=ymedi+boxysize
2207 zmedi=mod(zmedi,boxzsize)
2208 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2210 num_conti=num_cont_hb(i)
2211 c write(iout,*) "JESTEM W PETLI"
2212 call eelecij(i,i+3,ees,evdw1,eel_loc)
2213 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2214 & call eturn4(i,eello_turn4)
2215 num_cont_hb(i)=num_conti
2217 C Loop over all neighbouring boxes
2222 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2225 do i=iatel_s,iatel_e
2228 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2229 C changes suggested by Ana to avoid out of bounds
2230 c & .or.((i+2).gt.nres)
2231 c & .or.((i-1).le.0)
2232 C end of changes by Ana
2233 c & .or. itype(i+2).eq.ntyp1
2234 c & .or. itype(i-1).eq.ntyp1
2239 dx_normi=dc_norm(1,i)
2240 dy_normi=dc_norm(2,i)
2241 dz_normi=dc_norm(3,i)
2242 xmedi=c(1,i)+0.5d0*dxi
2243 ymedi=c(2,i)+0.5d0*dyi
2244 zmedi=c(3,i)+0.5d0*dzi
2245 xmedi=mod(xmedi,boxxsize)
2246 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2247 ymedi=mod(ymedi,boxysize)
2248 if (ymedi.lt.0) ymedi=ymedi+boxysize
2249 zmedi=mod(zmedi,boxzsize)
2250 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2251 C xmedi=xmedi+xshift*boxxsize
2252 C ymedi=ymedi+yshift*boxysize
2253 C zmedi=zmedi+zshift*boxzsize
2255 C Return tom into box, boxxsize is size of box in x dimension
2257 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2258 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2259 C Condition for being inside the proper box
2260 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2261 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2265 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2266 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2267 C Condition for being inside the proper box
2268 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2269 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2273 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2274 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2275 cC Condition for being inside the proper box
2276 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2277 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2281 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2282 num_conti=num_cont_hb(i)
2284 do j=ielstart(i),ielend(i)
2286 C write (iout,*) i,j
2288 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2289 C changes suggested by Ana to avoid out of bounds
2290 c & .or.((j+2).gt.nres)
2291 c & .or.((j-1).le.0)
2292 C end of changes by Ana
2293 c & .or.itype(j+2).eq.ntyp1
2294 c & .or.itype(j-1).eq.ntyp1
2296 call eelecij(i,j,ees,evdw1,eel_loc)
2298 num_cont_hb(i)=num_conti
2304 c write (iout,*) "Number of loop steps in EELEC:",ind
2306 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2307 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2309 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2310 ccc eel_loc=eel_loc+eello_turn3
2311 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2314 C-------------------------------------------------------------------------------
2315 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2316 implicit real*8 (a-h,o-z)
2317 include 'DIMENSIONS'
2318 include 'DIMENSIONS.ZSCOPT'
2322 include 'COMMON.CONTROL'
2323 include 'COMMON.IOUNITS'
2324 include 'COMMON.GEO'
2325 include 'COMMON.VAR'
2326 include 'COMMON.LOCAL'
2327 include 'COMMON.CHAIN'
2328 include 'COMMON.DERIV'
2329 include 'COMMON.INTERACT'
2330 include 'COMMON.CONTACTS'
2331 include 'COMMON.TORSION'
2332 include 'COMMON.VECTORS'
2333 include 'COMMON.FFIELD'
2334 include 'COMMON.TIME1'
2335 include 'COMMON.SPLITELE'
2336 include 'COMMON.SHIELD'
2337 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2338 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2339 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2340 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2341 & gmuij2(4),gmuji2(4)
2342 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2343 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2345 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2347 double precision scal_el /1.0d0/
2349 double precision scal_el /0.5d0/
2352 C 13-go grudnia roku pamietnego...
2353 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2354 & 0.0d0,1.0d0,0.0d0,
2355 & 0.0d0,0.0d0,1.0d0/
2356 integer xshift,yshift,zshift
2357 c time00=MPI_Wtime()
2358 cd write (iout,*) "eelecij",i,j
2362 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2363 aaa=app(iteli,itelj)
2364 bbb=bpp(iteli,itelj)
2365 ael6i=ael6(iteli,itelj)
2366 ael3i=ael3(iteli,itelj)
2370 dx_normj=dc_norm(1,j)
2371 dy_normj=dc_norm(2,j)
2372 dz_normj=dc_norm(3,j)
2373 C xj=c(1,j)+0.5D0*dxj-xmedi
2374 C yj=c(2,j)+0.5D0*dyj-ymedi
2375 C zj=c(3,j)+0.5D0*dzj-zmedi
2380 if (xj.lt.0) xj=xj+boxxsize
2382 if (yj.lt.0) yj=yj+boxysize
2384 if (zj.lt.0) zj=zj+boxzsize
2385 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2386 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2394 xj=xj_safe+xshift*boxxsize
2395 yj=yj_safe+yshift*boxysize
2396 zj=zj_safe+zshift*boxzsize
2397 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2398 if(dist_temp.lt.dist_init) then
2408 if (isubchap.eq.1) then
2417 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2419 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2420 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2421 C Condition for being inside the proper box
2422 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2423 c & (xj.lt.((-0.5d0)*boxxsize))) then
2427 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2428 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2429 C Condition for being inside the proper box
2430 c if ((yj.gt.((0.5d0)*boxysize)).or.
2431 c & (yj.lt.((-0.5d0)*boxysize))) then
2435 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2436 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2437 C Condition for being inside the proper box
2438 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2439 c & (zj.lt.((-0.5d0)*boxzsize))) then
2442 C endif !endPBC condintion
2446 rij=xj*xj+yj*yj+zj*zj
2448 sss=sscale(sqrt(rij))
2449 sssgrad=sscagrad(sqrt(rij))
2450 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2451 c & " rlamb",rlamb," sss",sss
2452 c if (sss.gt.0.0d0) then
2458 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2459 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2460 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2461 fac=cosa-3.0D0*cosb*cosg
2463 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2464 if (j.eq.i+2) ev1=scal_el*ev1
2469 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2473 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2474 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2475 if (shield_mode.gt.0) then
2478 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2479 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2488 evdw1=evdw1+evdwij*sss
2489 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2490 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2491 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2492 cd & xmedi,ymedi,zmedi,xj,yj,zj
2494 if (energy_dec) then
2495 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2497 &,iteli,itelj,aaa,evdw1,sss
2498 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2499 &fac_shield(i),fac_shield(j)
2503 C Calculate contributions to the Cartesian gradient.
2506 facvdw=-6*rrmij*(ev1+evdwij)*sss
2507 facel=-3*rrmij*(el1+eesij)
2514 * Radial derivatives. First process both termini of the fragment (i,j)
2520 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2521 & (shield_mode.gt.0)) then
2523 do ilist=1,ishield_list(i)
2524 iresshield=shield_list(ilist,i)
2526 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2528 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2530 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2531 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2532 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2533 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2534 C if (iresshield.gt.i) then
2535 C do ishi=i+1,iresshield-1
2536 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2537 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2541 C do ishi=iresshield,i
2542 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2543 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2549 do ilist=1,ishield_list(j)
2550 iresshield=shield_list(ilist,j)
2552 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2554 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2556 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2557 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2559 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2560 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2561 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2562 C if (iresshield.gt.j) then
2563 C do ishi=j+1,iresshield-1
2564 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2565 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2569 C do ishi=iresshield,j
2570 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2571 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2578 gshieldc(k,i)=gshieldc(k,i)+
2579 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2580 gshieldc(k,j)=gshieldc(k,j)+
2581 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2582 gshieldc(k,i-1)=gshieldc(k,i-1)+
2583 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2584 gshieldc(k,j-1)=gshieldc(k,j-1)+
2585 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2590 c ghalf=0.5D0*ggg(k)
2591 c gelc(k,i)=gelc(k,i)+ghalf
2592 c gelc(k,j)=gelc(k,j)+ghalf
2594 c 9/28/08 AL Gradient compotents will be summed only at the end
2595 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2597 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2598 C & +grad_shield(k,j)*eesij/fac_shield(j)
2599 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2600 C & +grad_shield(k,i)*eesij/fac_shield(i)
2601 C gelc_long(k,i-1)=gelc_long(k,i-1)
2602 C & +grad_shield(k,i)*eesij/fac_shield(i)
2603 C gelc_long(k,j-1)=gelc_long(k,j-1)
2604 C & +grad_shield(k,j)*eesij/fac_shield(j)
2606 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2609 * Loop over residues i+1 thru j-1.
2613 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2616 if (sss.gt.0.0) then
2617 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2618 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2619 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2626 c ghalf=0.5D0*ggg(k)
2627 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2628 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2630 c 9/28/08 AL Gradient compotents will be summed only at the end
2632 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2633 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2636 * Loop over residues i+1 thru j-1.
2640 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2646 facvdw=(ev1+evdwij)*sss
2649 fac=-3*rrmij*(facvdw+facvdw+facel)
2654 * Radial derivatives. First process both termini of the fragment (i,j)
2658 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2660 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2662 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2664 c ghalf=0.5D0*ggg(k)
2665 c gelc(k,i)=gelc(k,i)+ghalf
2666 c gelc(k,j)=gelc(k,j)+ghalf
2668 c 9/28/08 AL Gradient compotents will be summed only at the end
2670 gelc_long(k,j)=gelc(k,j)+ggg(k)
2671 gelc_long(k,i)=gelc(k,i)-ggg(k)
2674 * Loop over residues i+1 thru j-1.
2678 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2681 c 9/28/08 AL Gradient compotents will be summed only at the end
2682 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2683 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2684 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2686 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2687 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2695 ecosa=2.0D0*fac3*fac1+fac4
2698 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2699 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2701 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2702 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2704 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2705 cd & (dcosg(k),k=1,3)
2707 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2708 & fac_shield(i)**2*fac_shield(j)**2
2711 c ghalf=0.5D0*ggg(k)
2712 c gelc(k,i)=gelc(k,i)+ghalf
2713 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2714 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2715 c gelc(k,j)=gelc(k,j)+ghalf
2716 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2717 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2721 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2724 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2727 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2728 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2729 & *fac_shield(i)**2*fac_shield(j)**2
2731 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2732 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2733 & *fac_shield(i)**2*fac_shield(j)**2
2734 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2735 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2737 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2742 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2743 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2744 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2746 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2747 C energy of a peptide unit is assumed in the form of a second-order
2748 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2749 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2750 C are computed for EVERY pair of non-contiguous peptide groups.
2753 if (j.lt.nres-1) then
2765 muij(kkk)=mu(k,i)*mu(l,j)
2766 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2769 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2770 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2771 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2772 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2773 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2774 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2780 write (iout,*) 'EELEC: i',i,' j',j
2781 write (iout,*) 'j',j,' j1',j1,' j2',j2
2782 write(iout,*) 'muij',muij
2783 write (iout,*) "uy",uy(:,i)
2784 write (iout,*) "uz",uz(:,j)
2785 write (iout,*) "erij",erij
2787 ury=scalar(uy(1,i),erij)
2788 urz=scalar(uz(1,i),erij)
2789 vry=scalar(uy(1,j),erij)
2790 vrz=scalar(uz(1,j),erij)
2791 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2792 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2793 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2794 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2795 fac=dsqrt(-ael6i)*r3ij
2800 cd write (iout,'(4i5,4f10.5)')
2801 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2802 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2803 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2804 cd & uy(:,j),uz(:,j)
2805 cd write (iout,'(4f10.5)')
2806 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2807 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2808 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2809 cd write (iout,'(9f10.5/)')
2810 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2811 C Derivatives of the elements of A in virtual-bond vectors
2813 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2815 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2816 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2817 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2818 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2819 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2820 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2821 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2822 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2823 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2824 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2825 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2826 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2828 C Compute radial contributions to the gradient
2846 C Add the contributions coming from er
2849 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2850 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2851 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2852 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2855 C Derivatives in DC(i)
2856 cgrad ghalf1=0.5d0*agg(k,1)
2857 cgrad ghalf2=0.5d0*agg(k,2)
2858 cgrad ghalf3=0.5d0*agg(k,3)
2859 cgrad ghalf4=0.5d0*agg(k,4)
2860 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2861 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2862 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2863 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2864 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2865 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2866 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2867 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2868 C Derivatives in DC(i+1)
2869 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2870 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2871 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2872 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2873 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2874 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2875 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2876 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2877 C Derivatives in DC(j)
2878 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2879 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2880 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2881 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2882 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2883 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2884 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2885 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2886 C Derivatives in DC(j+1) or DC(nres-1)
2887 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2888 & -3.0d0*vryg(k,3)*ury)
2889 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2890 & -3.0d0*vrzg(k,3)*ury)
2891 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2892 & -3.0d0*vryg(k,3)*urz)
2893 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2894 & -3.0d0*vrzg(k,3)*urz)
2895 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2897 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2912 aggi(k,l)=-aggi(k,l)
2913 aggi1(k,l)=-aggi1(k,l)
2914 aggj(k,l)=-aggj(k,l)
2915 aggj1(k,l)=-aggj1(k,l)
2919 if (j.lt.nres-1) then
2925 aggi(k,l)=-aggi(k,l)
2926 aggi1(k,l)=-aggi1(k,l)
2927 aggj(k,l)=-aggj(k,l)
2928 aggj1(k,l)=-aggj1(k,l)
2939 aggi(k,l)=-aggi(k,l)
2940 aggi1(k,l)=-aggi1(k,l)
2941 aggj(k,l)=-aggj(k,l)
2942 aggj1(k,l)=-aggj1(k,l)
2947 IF (wel_loc.gt.0.0d0) THEN
2948 C Contribution to the local-electrostatic energy coming from the i-j pair
2949 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2952 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
2954 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
2955 & " wel_loc",wel_loc
2957 if (shield_mode.eq.0) then
2964 eel_loc_ij=eel_loc_ij
2965 & *fac_shield(i)*fac_shield(j)
2966 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2967 & 'eelloc',i,j,eel_loc_ij
2968 c if (eel_loc_ij.ne.0)
2969 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
2970 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
2972 eel_loc=eel_loc+eel_loc_ij
2973 C Now derivative over eel_loc
2975 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2976 & (shield_mode.gt.0)) then
2979 do ilist=1,ishield_list(i)
2980 iresshield=shield_list(ilist,i)
2982 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2985 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2987 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2988 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2992 do ilist=1,ishield_list(j)
2993 iresshield=shield_list(ilist,j)
2995 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2998 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
3000 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
3001 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
3008 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
3009 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3010 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
3011 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3012 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
3013 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
3014 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
3015 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
3020 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3021 c & ' eel_loc_ij',eel_loc_ij
3022 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3023 C Calculate patrial derivative for theta angle
3025 geel_loc_ij=(a22*gmuij1(1)
3029 & *fac_shield(i)*fac_shield(j)
3030 c write(iout,*) "derivative over thatai"
3031 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3033 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3034 & geel_loc_ij*wel_loc
3035 c write(iout,*) "derivative over thatai-1"
3036 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3043 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3044 & geel_loc_ij*wel_loc
3045 & *fac_shield(i)*fac_shield(j)
3047 c Derivative over j residue
3048 geel_loc_ji=a22*gmuji1(1)
3052 c write(iout,*) "derivative over thataj"
3053 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3056 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3057 & geel_loc_ji*wel_loc
3058 & *fac_shield(i)*fac_shield(j)
3065 c write(iout,*) "derivative over thataj-1"
3066 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3068 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3069 & geel_loc_ji*wel_loc
3070 & *fac_shield(i)*fac_shield(j)
3072 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3074 C Partial derivatives in virtual-bond dihedral angles gamma
3076 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3077 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3078 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3079 & *fac_shield(i)*fac_shield(j)
3081 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3082 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3083 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3084 & *fac_shield(i)*fac_shield(j)
3085 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3087 ggg(l)=(agg(l,1)*muij(1)+
3088 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3089 & *fac_shield(i)*fac_shield(j)
3090 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3091 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3092 cgrad ghalf=0.5d0*ggg(l)
3093 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3094 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3098 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3101 C Remaining derivatives of eello
3103 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3104 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3105 & *fac_shield(i)*fac_shield(j)
3107 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3108 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3109 & *fac_shield(i)*fac_shield(j)
3111 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3112 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3113 & *fac_shield(i)*fac_shield(j)
3115 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3116 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3117 & *fac_shield(i)*fac_shield(j)
3124 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3125 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3126 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3127 & .and. num_conti.le.maxconts) then
3128 c write (iout,*) i,j," entered corr"
3130 C Calculate the contact function. The ith column of the array JCONT will
3131 C contain the numbers of atoms that make contacts with the atom I (of numbers
3132 C greater than I). The arrays FACONT and GACONT will contain the values of
3133 C the contact function and its derivative.
3134 c r0ij=1.02D0*rpp(iteli,itelj)
3135 c r0ij=1.11D0*rpp(iteli,itelj)
3136 r0ij=2.20D0*rpp(iteli,itelj)
3137 c r0ij=1.55D0*rpp(iteli,itelj)
3138 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3139 if (fcont.gt.0.0D0) then
3140 num_conti=num_conti+1
3141 if (num_conti.gt.maxconts) then
3142 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3143 & ' will skip next contacts for this conf.'
3145 jcont_hb(num_conti,i)=j
3146 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3147 cd & " jcont_hb",jcont_hb(num_conti,i)
3148 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3149 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3150 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3152 d_cont(num_conti,i)=rij
3153 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3154 C --- Electrostatic-interaction matrix ---
3155 a_chuj(1,1,num_conti,i)=a22
3156 a_chuj(1,2,num_conti,i)=a23
3157 a_chuj(2,1,num_conti,i)=a32
3158 a_chuj(2,2,num_conti,i)=a33
3159 C --- Gradient of rij
3162 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3169 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3170 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3171 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3172 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3173 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3179 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3180 C Calculate contact energies
3182 wij=cosa-3.0D0*cosb*cosg
3185 c fac3=dsqrt(-ael6i)/r0ij**3
3186 fac3=dsqrt(-ael6i)*r3ij
3187 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3188 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3189 if (ees0tmp.gt.0) then
3190 ees0pij=dsqrt(ees0tmp)
3194 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3195 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3196 if (ees0tmp.gt.0) then
3197 ees0mij=dsqrt(ees0tmp)
3202 if (shield_mode.eq.0) then
3206 ees0plist(num_conti,i)=j
3207 C fac_shield(i)=0.4d0
3208 C fac_shield(j)=0.6d0
3210 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3211 & *fac_shield(i)*fac_shield(j)
3212 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3213 & *fac_shield(i)*fac_shield(j)
3214 C Diagnostics. Comment out or remove after debugging!
3215 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3216 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3217 c ees0m(num_conti,i)=0.0D0
3219 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3220 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3221 C Angular derivatives of the contact function
3223 ees0pij1=fac3/ees0pij
3224 ees0mij1=fac3/ees0mij
3225 fac3p=-3.0D0*fac3*rrmij
3226 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3227 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3229 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3230 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3231 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3232 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3233 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3234 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3235 ecosap=ecosa1+ecosa2
3236 ecosbp=ecosb1+ecosb2
3237 ecosgp=ecosg1+ecosg2
3238 ecosam=ecosa1-ecosa2
3239 ecosbm=ecosb1-ecosb2
3240 ecosgm=ecosg1-ecosg2
3249 facont_hb(num_conti,i)=fcont
3252 fprimcont=fprimcont/rij
3253 cd facont_hb(num_conti,i)=1.0D0
3254 C Following line is for diagnostics.
3257 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3258 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3261 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3262 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3264 gggp(1)=gggp(1)+ees0pijp*xj
3265 gggp(2)=gggp(2)+ees0pijp*yj
3266 gggp(3)=gggp(3)+ees0pijp*zj
3267 gggm(1)=gggm(1)+ees0mijp*xj
3268 gggm(2)=gggm(2)+ees0mijp*yj
3269 gggm(3)=gggm(3)+ees0mijp*zj
3270 C Derivatives due to the contact function
3271 gacont_hbr(1,num_conti,i)=fprimcont*xj
3272 gacont_hbr(2,num_conti,i)=fprimcont*yj
3273 gacont_hbr(3,num_conti,i)=fprimcont*zj
3276 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3277 c following the change of gradient-summation algorithm.
3279 cgrad ghalfp=0.5D0*gggp(k)
3280 cgrad ghalfm=0.5D0*gggm(k)
3281 gacontp_hb1(k,num_conti,i)=!ghalfp
3282 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3283 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3284 & *fac_shield(i)*fac_shield(j)
3286 gacontp_hb2(k,num_conti,i)=!ghalfp
3287 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3288 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3289 & *fac_shield(i)*fac_shield(j)
3291 gacontp_hb3(k,num_conti,i)=gggp(k)
3292 & *fac_shield(i)*fac_shield(j)
3294 gacontm_hb1(k,num_conti,i)=!ghalfm
3295 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3296 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3297 & *fac_shield(i)*fac_shield(j)
3299 gacontm_hb2(k,num_conti,i)=!ghalfm
3300 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3301 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3302 & *fac_shield(i)*fac_shield(j)
3304 gacontm_hb3(k,num_conti,i)=gggm(k)
3305 & *fac_shield(i)*fac_shield(j)
3308 C Diagnostics. Comment out or remove after debugging!
3310 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3311 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3312 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3313 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3314 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3315 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3321 endif ! num_conti.le.maxconts
3325 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3328 ghalf=0.5d0*agg(l,k)
3329 aggi(l,k)=aggi(l,k)+ghalf
3330 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3331 aggj(l,k)=aggj(l,k)+ghalf
3334 if (j.eq.nres-1 .and. i.lt.j-2) then
3337 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3343 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3346 C-----------------------------------------------------------------------------
3347 subroutine eturn3(i,eello_turn3)
3348 C Third- and fourth-order contributions from turns
3349 implicit real*8 (a-h,o-z)
3350 include 'DIMENSIONS'
3351 include 'DIMENSIONS.ZSCOPT'
3352 include 'COMMON.IOUNITS'
3353 include 'COMMON.GEO'
3354 include 'COMMON.VAR'
3355 include 'COMMON.LOCAL'
3356 include 'COMMON.CHAIN'
3357 include 'COMMON.DERIV'
3358 include 'COMMON.INTERACT'
3359 include 'COMMON.CONTACTS'
3360 include 'COMMON.TORSION'
3361 include 'COMMON.VECTORS'
3362 include 'COMMON.FFIELD'
3363 include 'COMMON.CONTROL'
3364 include 'COMMON.SHIELD'
3366 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3367 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3368 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3369 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3370 & auxgmat2(2,2),auxgmatt2(2,2)
3371 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3372 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3373 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3374 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3377 c write (iout,*) "eturn3",i,j,j1,j2
3382 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3384 C Third-order contributions
3391 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3392 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3393 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3394 c auxalary matices for theta gradient
3395 c auxalary matrix for i+1 and constant i+2
3396 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3397 c auxalary matrix for i+2 and constant i+1
3398 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3399 call transpose2(auxmat(1,1),auxmat1(1,1))
3400 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3401 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3402 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3403 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3404 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3405 if (shield_mode.eq.0) then
3412 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3413 & *fac_shield(i)*fac_shield(j)
3414 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3415 & *fac_shield(i)*fac_shield(j)
3416 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3420 C Derivatives in theta
3421 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3422 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3423 & *fac_shield(i)*fac_shield(j)
3424 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3425 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3426 & *fac_shield(i)*fac_shield(j)
3429 C Derivatives in shield mode
3430 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3431 & (shield_mode.gt.0)) then
3434 do ilist=1,ishield_list(i)
3435 iresshield=shield_list(ilist,i)
3437 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3439 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3441 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3442 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3446 do ilist=1,ishield_list(j)
3447 iresshield=shield_list(ilist,j)
3449 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3451 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3453 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3454 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3461 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3462 & grad_shield(k,i)*eello_t3/fac_shield(i)
3463 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3464 & grad_shield(k,j)*eello_t3/fac_shield(j)
3465 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3466 & grad_shield(k,i)*eello_t3/fac_shield(i)
3467 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3468 & grad_shield(k,j)*eello_t3/fac_shield(j)
3472 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3473 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3474 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3475 cd & ' eello_turn3_num',4*eello_turn3_num
3476 C Derivatives in gamma(i)
3477 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3478 call transpose2(auxmat2(1,1),auxmat3(1,1))
3479 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3480 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3481 & *fac_shield(i)*fac_shield(j)
3482 C Derivatives in gamma(i+1)
3483 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3484 call transpose2(auxmat2(1,1),auxmat3(1,1))
3485 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3486 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3487 & +0.5d0*(pizda(1,1)+pizda(2,2))
3488 & *fac_shield(i)*fac_shield(j)
3489 C Cartesian derivatives
3491 c ghalf1=0.5d0*agg(l,1)
3492 c ghalf2=0.5d0*agg(l,2)
3493 c ghalf3=0.5d0*agg(l,3)
3494 c ghalf4=0.5d0*agg(l,4)
3495 a_temp(1,1)=aggi(l,1)!+ghalf1
3496 a_temp(1,2)=aggi(l,2)!+ghalf2
3497 a_temp(2,1)=aggi(l,3)!+ghalf3
3498 a_temp(2,2)=aggi(l,4)!+ghalf4
3499 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3500 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3501 & +0.5d0*(pizda(1,1)+pizda(2,2))
3502 & *fac_shield(i)*fac_shield(j)
3504 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3505 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3506 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3507 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3508 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3509 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3510 & +0.5d0*(pizda(1,1)+pizda(2,2))
3511 & *fac_shield(i)*fac_shield(j)
3512 a_temp(1,1)=aggj(l,1)!+ghalf1
3513 a_temp(1,2)=aggj(l,2)!+ghalf2
3514 a_temp(2,1)=aggj(l,3)!+ghalf3
3515 a_temp(2,2)=aggj(l,4)!+ghalf4
3516 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3517 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3518 & +0.5d0*(pizda(1,1)+pizda(2,2))
3519 & *fac_shield(i)*fac_shield(j)
3520 a_temp(1,1)=aggj1(l,1)
3521 a_temp(1,2)=aggj1(l,2)
3522 a_temp(2,1)=aggj1(l,3)
3523 a_temp(2,2)=aggj1(l,4)
3524 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3525 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3526 & +0.5d0*(pizda(1,1)+pizda(2,2))
3527 & *fac_shield(i)*fac_shield(j)
3534 C-------------------------------------------------------------------------------
3535 subroutine eturn4(i,eello_turn4)
3536 C Third- and fourth-order contributions from turns
3537 implicit real*8 (a-h,o-z)
3538 include 'DIMENSIONS'
3539 include 'DIMENSIONS.ZSCOPT'
3540 include 'COMMON.IOUNITS'
3541 include 'COMMON.GEO'
3542 include 'COMMON.VAR'
3543 include 'COMMON.LOCAL'
3544 include 'COMMON.CHAIN'
3545 include 'COMMON.DERIV'
3546 include 'COMMON.INTERACT'
3547 include 'COMMON.CONTACTS'
3548 include 'COMMON.TORSION'
3549 include 'COMMON.VECTORS'
3550 include 'COMMON.FFIELD'
3551 include 'COMMON.CONTROL'
3552 include 'COMMON.SHIELD'
3554 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3555 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3556 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3557 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3558 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3559 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3560 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3561 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3562 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3563 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3564 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3567 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3569 C Fourth-order contributions
3577 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3578 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3579 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3580 c write(iout,*)"WCHODZE W PROGRAM"
3585 iti1=itype2loc(itype(i+1))
3586 iti2=itype2loc(itype(i+2))
3587 iti3=itype2loc(itype(i+3))
3588 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3589 call transpose2(EUg(1,1,i+1),e1t(1,1))
3590 call transpose2(Eug(1,1,i+2),e2t(1,1))
3591 call transpose2(Eug(1,1,i+3),e3t(1,1))
3592 C Ematrix derivative in theta
3593 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3594 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3595 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3596 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3597 c eta1 in derivative theta
3598 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3599 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3600 c auxgvec is derivative of Ub2 so i+3 theta
3601 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3602 c auxalary matrix of E i+1
3603 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3606 s1=scalar2(b1(1,i+2),auxvec(1))
3607 c derivative of theta i+2 with constant i+3
3608 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3609 c derivative of theta i+2 with constant i+2
3610 gs32=scalar2(b1(1,i+2),auxgvec(1))
3611 c derivative of E matix in theta of i+1
3612 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3614 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3615 c ea31 in derivative theta
3616 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3617 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3618 c auxilary matrix auxgvec of Ub2 with constant E matirx
3619 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3620 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3621 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3625 s2=scalar2(b1(1,i+1),auxvec(1))
3626 c derivative of theta i+1 with constant i+3
3627 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3628 c derivative of theta i+2 with constant i+1
3629 gs21=scalar2(b1(1,i+1),auxgvec(1))
3630 c derivative of theta i+3 with constant i+1
3631 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3632 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3634 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3635 c two derivatives over diffetent matrices
3636 c gtae3e2 is derivative over i+3
3637 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3638 c ae3gte2 is derivative over i+2
3639 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3640 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3641 c three possible derivative over theta E matices
3643 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3645 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3647 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3648 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3650 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3651 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3652 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3653 if (shield_mode.eq.0) then
3660 eello_turn4=eello_turn4-(s1+s2+s3)
3661 & *fac_shield(i)*fac_shield(j)
3662 eello_t4=-(s1+s2+s3)
3663 & *fac_shield(i)*fac_shield(j)
3664 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3665 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3666 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3667 C Now derivative over shield:
3668 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3669 & (shield_mode.gt.0)) then
3672 do ilist=1,ishield_list(i)
3673 iresshield=shield_list(ilist,i)
3675 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3677 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3679 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3680 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3684 do ilist=1,ishield_list(j)
3685 iresshield=shield_list(ilist,j)
3687 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3689 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3691 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3692 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3699 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3700 & grad_shield(k,i)*eello_t4/fac_shield(i)
3701 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3702 & grad_shield(k,j)*eello_t4/fac_shield(j)
3703 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3704 & grad_shield(k,i)*eello_t4/fac_shield(i)
3705 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3706 & grad_shield(k,j)*eello_t4/fac_shield(j)
3709 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3710 cd & ' eello_turn4_num',8*eello_turn4_num
3712 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3713 & -(gs13+gsE13+gsEE1)*wturn4
3714 & *fac_shield(i)*fac_shield(j)
3715 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3716 & -(gs23+gs21+gsEE2)*wturn4
3717 & *fac_shield(i)*fac_shield(j)
3719 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3720 & -(gs32+gsE31+gsEE3)*wturn4
3721 & *fac_shield(i)*fac_shield(j)
3723 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3726 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3727 & 'eturn4',i,j,-(s1+s2+s3)
3728 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3729 c & ' eello_turn4_num',8*eello_turn4_num
3730 C Derivatives in gamma(i)
3731 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3732 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3733 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3734 s1=scalar2(b1(1,i+2),auxvec(1))
3735 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3736 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3737 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3738 & *fac_shield(i)*fac_shield(j)
3739 C Derivatives in gamma(i+1)
3740 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3741 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3742 s2=scalar2(b1(1,i+1),auxvec(1))
3743 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3744 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3745 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3746 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3747 & *fac_shield(i)*fac_shield(j)
3748 C Derivatives in gamma(i+2)
3749 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3750 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3751 s1=scalar2(b1(1,i+2),auxvec(1))
3752 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3753 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3754 s2=scalar2(b1(1,i+1),auxvec(1))
3755 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3756 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3757 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3758 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3759 & *fac_shield(i)*fac_shield(j)
3761 C Cartesian derivatives
3762 C Derivatives of this turn contributions in DC(i+2)
3763 if (j.lt.nres-1) then
3765 a_temp(1,1)=agg(l,1)
3766 a_temp(1,2)=agg(l,2)
3767 a_temp(2,1)=agg(l,3)
3768 a_temp(2,2)=agg(l,4)
3769 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3770 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3771 s1=scalar2(b1(1,i+2),auxvec(1))
3772 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3773 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3774 s2=scalar2(b1(1,i+1),auxvec(1))
3775 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3776 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3777 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3779 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3780 & *fac_shield(i)*fac_shield(j)
3783 C Remaining derivatives of this turn contribution
3785 a_temp(1,1)=aggi(l,1)
3786 a_temp(1,2)=aggi(l,2)
3787 a_temp(2,1)=aggi(l,3)
3788 a_temp(2,2)=aggi(l,4)
3789 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3790 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3791 s1=scalar2(b1(1,i+2),auxvec(1))
3792 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3793 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3794 s2=scalar2(b1(1,i+1),auxvec(1))
3795 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3796 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3797 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3798 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3799 & *fac_shield(i)*fac_shield(j)
3800 a_temp(1,1)=aggi1(l,1)
3801 a_temp(1,2)=aggi1(l,2)
3802 a_temp(2,1)=aggi1(l,3)
3803 a_temp(2,2)=aggi1(l,4)
3804 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3805 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3806 s1=scalar2(b1(1,i+2),auxvec(1))
3807 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3808 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3809 s2=scalar2(b1(1,i+1),auxvec(1))
3810 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3811 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3812 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3813 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3814 & *fac_shield(i)*fac_shield(j)
3815 a_temp(1,1)=aggj(l,1)
3816 a_temp(1,2)=aggj(l,2)
3817 a_temp(2,1)=aggj(l,3)
3818 a_temp(2,2)=aggj(l,4)
3819 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3820 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3821 s1=scalar2(b1(1,i+2),auxvec(1))
3822 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3823 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3824 s2=scalar2(b1(1,i+1),auxvec(1))
3825 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3826 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3827 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3828 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3829 & *fac_shield(i)*fac_shield(j)
3830 a_temp(1,1)=aggj1(l,1)
3831 a_temp(1,2)=aggj1(l,2)
3832 a_temp(2,1)=aggj1(l,3)
3833 a_temp(2,2)=aggj1(l,4)
3834 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3835 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3836 s1=scalar2(b1(1,i+2),auxvec(1))
3837 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3838 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3839 s2=scalar2(b1(1,i+1),auxvec(1))
3840 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3841 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3842 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3843 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3844 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3845 & *fac_shield(i)*fac_shield(j)
3852 C-----------------------------------------------------------------------------
3853 subroutine vecpr(u,v,w)
3854 implicit real*8(a-h,o-z)
3855 dimension u(3),v(3),w(3)
3856 w(1)=u(2)*v(3)-u(3)*v(2)
3857 w(2)=-u(1)*v(3)+u(3)*v(1)
3858 w(3)=u(1)*v(2)-u(2)*v(1)
3861 C-----------------------------------------------------------------------------
3862 subroutine unormderiv(u,ugrad,unorm,ungrad)
3863 C This subroutine computes the derivatives of a normalized vector u, given
3864 C the derivatives computed without normalization conditions, ugrad. Returns
3867 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3868 double precision vec(3)
3869 double precision scalar
3871 c write (2,*) 'ugrad',ugrad
3874 vec(i)=scalar(ugrad(1,i),u(1))
3876 c write (2,*) 'vec',vec
3879 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3882 c write (2,*) 'ungrad',ungrad
3885 C-----------------------------------------------------------------------------
3886 subroutine escp(evdw2,evdw2_14)
3888 C This subroutine calculates the excluded-volume interaction energy between
3889 C peptide-group centers and side chains and its gradient in virtual-bond and
3890 C side-chain vectors.
3892 implicit real*8 (a-h,o-z)
3893 include 'DIMENSIONS'
3894 include 'DIMENSIONS.ZSCOPT'
3895 include 'COMMON.CONTROL'
3896 include 'COMMON.GEO'
3897 include 'COMMON.VAR'
3898 include 'COMMON.LOCAL'
3899 include 'COMMON.CHAIN'
3900 include 'COMMON.DERIV'
3901 include 'COMMON.INTERACT'
3902 include 'COMMON.FFIELD'
3903 include 'COMMON.IOUNITS'
3907 cd print '(a)','Enter ESCP'
3908 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3909 c & ' scal14',scal14
3910 do i=iatscp_s,iatscp_e
3911 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3913 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3914 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3915 if (iteli.eq.0) goto 1225
3916 xi=0.5D0*(c(1,i)+c(1,i+1))
3917 yi=0.5D0*(c(2,i)+c(2,i+1))
3918 zi=0.5D0*(c(3,i)+c(3,i+1))
3919 C Returning the ith atom to box
3921 if (xi.lt.0) xi=xi+boxxsize
3923 if (yi.lt.0) yi=yi+boxysize
3925 if (zi.lt.0) zi=zi+boxzsize
3926 do iint=1,nscp_gr(i)
3928 do j=iscpstart(i,iint),iscpend(i,iint)
3929 itypj=iabs(itype(j))
3930 if (itypj.eq.ntyp1) cycle
3931 C Uncomment following three lines for SC-p interactions
3935 C Uncomment following three lines for Ca-p interactions
3939 C returning the jth atom to box
3941 if (xj.lt.0) xj=xj+boxxsize
3943 if (yj.lt.0) yj=yj+boxysize
3945 if (zj.lt.0) zj=zj+boxzsize
3946 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3951 C Finding the closest jth atom
3955 xj=xj_safe+xshift*boxxsize
3956 yj=yj_safe+yshift*boxysize
3957 zj=zj_safe+zshift*boxzsize
3958 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3959 if(dist_temp.lt.dist_init) then
3969 if (subchap.eq.1) then
3978 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3979 C sss is scaling function for smoothing the cutoff gradient otherwise
3980 C the gradient would not be continuouse
3981 sss=sscale(1.0d0/(dsqrt(rrij)))
3982 if (sss.le.0.0d0) cycle
3983 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3985 e1=fac*fac*aad(itypj,iteli)
3986 e2=fac*bad(itypj,iteli)
3987 if (iabs(j-i) .le. 2) then
3990 evdw2_14=evdw2_14+(e1+e2)*sss
3993 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3994 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3995 c & bad(itypj,iteli)
3996 evdw2=evdw2+evdwij*sss
3997 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3998 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4003 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4005 fac=-(evdwij+e1)*rrij*sss
4006 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4011 cd write (iout,*) 'j<i'
4012 C Uncomment following three lines for SC-p interactions
4014 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4017 cd write (iout,*) 'j>i'
4020 C Uncomment following line for SC-p interactions
4021 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4025 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4029 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4030 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4033 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4043 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4044 gradx_scp(j,i)=expon*gradx_scp(j,i)
4047 C******************************************************************************
4051 C To save time the factor EXPON has been extracted from ALL components
4052 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4055 C******************************************************************************
4058 C--------------------------------------------------------------------------
4059 subroutine edis(ehpb)
4061 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4063 implicit real*8 (a-h,o-z)
4064 include 'DIMENSIONS'
4065 include 'DIMENSIONS.ZSCOPT'
4066 include 'COMMON.SBRIDGE'
4067 include 'COMMON.CHAIN'
4068 include 'COMMON.DERIV'
4069 include 'COMMON.VAR'
4070 include 'COMMON.INTERACT'
4071 include 'COMMON.CONTROL'
4072 include 'COMMON.IOUNITS'
4078 C write (iout,*) ,"link_end",link_end,constr_dist
4079 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4080 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4081 c & " constr_dist",constr_dist
4082 if (link_end.eq.0) return
4083 do i=link_start,link_end
4084 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4085 C CA-CA distance used in regularization of structure.
4088 C iii and jjj point to the residues for which the distance is assigned.
4089 if (ii.gt.nres) then
4096 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4097 c & dhpb(i),dhpb1(i),forcon(i)
4098 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4099 C distance and angle dependent SS bond potential.
4100 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4101 C & iabs(itype(jjj)).eq.1) then
4102 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4103 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4104 if (.not.dyn_ss .and. i.le.nss) then
4105 C 15/02/13 CC dynamic SSbond - additional check
4106 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4107 & iabs(itype(jjj)).eq.1) then
4108 call ssbond_ene(iii,jjj,eij)
4111 cd write (iout,*) "eij",eij
4112 cd & ' waga=',waga,' fac=',fac
4113 ! else if (ii.gt.nres .and. jj.gt.nres) then
4115 C Calculate the distance between the two points and its difference from the
4118 if (irestr_type(i).eq.11) then
4119 ehpb=ehpb+fordepth(i)!**4.0d0
4120 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4121 fac=fordepth(i)!**4.0d0
4122 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4123 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4124 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4125 & ehpb,irestr_type(i)
4126 else if (irestr_type(i).eq.10) then
4127 c AL 6//19/2018 cross-link restraints
4128 xdis = 0.5d0*(dd/forcon(i))**2
4129 expdis = dexp(-xdis)
4130 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4131 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4132 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4133 c & " wboltzd",wboltzd
4134 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4135 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4136 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4137 & *expdis/(aux*forcon(i)**2)
4138 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4139 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4140 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4141 else if (irestr_type(i).eq.2) then
4142 c Quartic restraints
4143 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4144 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4145 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4146 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4147 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4149 c Quadratic restraints
4151 C Get the force constant corresponding to this distance.
4153 C Calculate the contribution to energy.
4154 ehpb=ehpb+0.5d0*waga*rdis*rdis
4155 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4156 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4157 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4159 C Evaluate gradient.
4163 c Calculate Cartesian gradient
4165 ggg(j)=fac*(c(j,jj)-c(j,ii))
4167 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4168 C If this is a SC-SC distance, we need to calculate the contributions to the
4169 C Cartesian gradient in the SC vectors (ghpbx).
4172 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4173 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4177 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4178 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4184 C--------------------------------------------------------------------------
4185 subroutine ssbond_ene(i,j,eij)
4187 C Calculate the distance and angle dependent SS-bond potential energy
4188 C using a free-energy function derived based on RHF/6-31G** ab initio
4189 C calculations of diethyl disulfide.
4191 C A. Liwo and U. Kozlowska, 11/24/03
4193 implicit real*8 (a-h,o-z)
4194 include 'DIMENSIONS'
4195 include 'DIMENSIONS.ZSCOPT'
4196 include 'COMMON.SBRIDGE'
4197 include 'COMMON.CHAIN'
4198 include 'COMMON.DERIV'
4199 include 'COMMON.LOCAL'
4200 include 'COMMON.INTERACT'
4201 include 'COMMON.VAR'
4202 include 'COMMON.IOUNITS'
4203 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4204 itypi=iabs(itype(i))
4208 dxi=dc_norm(1,nres+i)
4209 dyi=dc_norm(2,nres+i)
4210 dzi=dc_norm(3,nres+i)
4211 dsci_inv=dsc_inv(itypi)
4212 itypj=iabs(itype(j))
4213 dscj_inv=dsc_inv(itypj)
4217 dxj=dc_norm(1,nres+j)
4218 dyj=dc_norm(2,nres+j)
4219 dzj=dc_norm(3,nres+j)
4220 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4225 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4226 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4227 om12=dxi*dxj+dyi*dyj+dzi*dzj
4229 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4230 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4236 deltat12=om2-om1+2.0d0
4238 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4239 & +akct*deltad*deltat12
4240 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4241 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4242 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4243 c & " deltat12",deltat12," eij",eij
4244 ed=2*akcm*deltad+akct*deltat12
4246 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4247 eom1=-2*akth*deltat1-pom1-om2*pom2
4248 eom2= 2*akth*deltat2+pom1-om1*pom2
4251 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4254 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4255 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4256 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4257 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4260 C Calculate the components of the gradient in DC and X
4264 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4269 C--------------------------------------------------------------------------
4270 subroutine ebond(estr)
4272 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4274 implicit real*8 (a-h,o-z)
4275 include 'DIMENSIONS'
4276 include 'DIMENSIONS.ZSCOPT'
4277 include 'COMMON.LOCAL'
4278 include 'COMMON.GEO'
4279 include 'COMMON.INTERACT'
4280 include 'COMMON.DERIV'
4281 include 'COMMON.VAR'
4282 include 'COMMON.CHAIN'
4283 include 'COMMON.IOUNITS'
4284 include 'COMMON.NAMES'
4285 include 'COMMON.FFIELD'
4286 include 'COMMON.CONTROL'
4287 double precision u(3),ud(3)
4290 c write (iout,*) "distchainmax",distchainmax
4292 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4293 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4295 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4296 C & *dc(j,i-1)/vbld(i)
4298 C if (energy_dec) write(iout,*)
4299 C & "estr1",i,vbld(i),distchainmax,
4300 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4302 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4303 diff = vbld(i)-vbldpDUM
4304 C write(iout,*) i,diff
4306 diff = vbld(i)-vbldp0
4307 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4311 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4314 C write (iout,'(a7,i5,4f7.3)')
4315 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4317 estr=0.5d0*AKP*estr+estr1
4319 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4323 if (iti.ne.10 .and. iti.ne.ntyp1) then
4326 diff=vbld(i+nres)-vbldsc0(1,iti)
4327 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4328 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4329 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4331 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4335 diff=vbld(i+nres)-vbldsc0(j,iti)
4336 ud(j)=aksc(j,iti)*diff
4337 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4351 uprod2=uprod2*u(k)*u(k)
4355 usumsqder=usumsqder+ud(j)*uprod2
4357 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4358 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4359 estr=estr+uprod/usum
4361 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4369 C--------------------------------------------------------------------------
4370 subroutine ebend(etheta,ethetacnstr)
4372 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4373 C angles gamma and its derivatives in consecutive thetas and gammas.
4375 implicit real*8 (a-h,o-z)
4376 include 'DIMENSIONS'
4377 include 'DIMENSIONS.ZSCOPT'
4378 include 'COMMON.LOCAL'
4379 include 'COMMON.GEO'
4380 include 'COMMON.INTERACT'
4381 include 'COMMON.DERIV'
4382 include 'COMMON.VAR'
4383 include 'COMMON.CHAIN'
4384 include 'COMMON.IOUNITS'
4385 include 'COMMON.NAMES'
4386 include 'COMMON.FFIELD'
4387 include 'COMMON.TORCNSTR'
4388 common /calcthet/ term1,term2,termm,diffak,ratak,
4389 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4390 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4391 double precision y(2),z(2)
4393 c time11=dexp(-2*time)
4396 c write (iout,*) "nres",nres
4397 c write (*,'(a,i2)') 'EBEND ICG=',icg
4398 c write (iout,*) ithet_start,ithet_end
4399 do i=ithet_start,ithet_end
4400 C if (itype(i-1).eq.ntyp1) cycle
4402 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4403 & .or.itype(i).eq.ntyp1) cycle
4404 C Zero the energy function and its derivative at 0 or pi.
4405 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4407 ichir1=isign(1,itype(i-2))
4408 ichir2=isign(1,itype(i))
4409 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4410 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4411 if (itype(i-1).eq.10) then
4412 itype1=isign(10,itype(i-2))
4413 ichir11=isign(1,itype(i-2))
4414 ichir12=isign(1,itype(i-2))
4415 itype2=isign(10,itype(i))
4416 ichir21=isign(1,itype(i))
4417 ichir22=isign(1,itype(i))
4424 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4428 c call proc_proc(phii,icrc)
4429 if (icrc.eq.1) phii=150.0
4440 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4444 c call proc_proc(phii1,icrc)
4445 if (icrc.eq.1) phii1=150.0
4457 C Calculate the "mean" value of theta from the part of the distribution
4458 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4459 C In following comments this theta will be referred to as t_c.
4460 thet_pred_mean=0.0d0
4462 athetk=athet(k,it,ichir1,ichir2)
4463 bthetk=bthet(k,it,ichir1,ichir2)
4465 athetk=athet(k,itype1,ichir11,ichir12)
4466 bthetk=bthet(k,itype2,ichir21,ichir22)
4468 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4470 c write (iout,*) "thet_pred_mean",thet_pred_mean
4471 dthett=thet_pred_mean*ssd
4472 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4473 c write (iout,*) "thet_pred_mean",thet_pred_mean
4474 C Derivatives of the "mean" values in gamma1 and gamma2.
4475 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4476 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4477 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4478 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4480 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4481 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4482 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4483 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4485 if (theta(i).gt.pi-delta) then
4486 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4488 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4489 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4490 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4492 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4494 else if (theta(i).lt.delta) then
4495 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4496 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4497 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4499 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4500 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4503 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4506 etheta=etheta+ethetai
4507 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4508 c & 'ebend',i,ethetai,theta(i),itype(i)
4509 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4510 c & rad2deg*phii,rad2deg*phii1,ethetai
4511 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4512 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4513 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4517 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4518 do i=1,ntheta_constr
4519 itheta=itheta_constr(i)
4520 thetiii=theta(itheta)
4521 difi=pinorm(thetiii-theta_constr0(i))
4522 if (difi.gt.theta_drange(i)) then
4523 difi=difi-theta_drange(i)
4524 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4525 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4526 & +for_thet_constr(i)*difi**3
4527 else if (difi.lt.-drange(i)) then
4529 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4530 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4531 & +for_thet_constr(i)*difi**3
4535 C if (energy_dec) then
4536 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4537 C & i,itheta,rad2deg*thetiii,
4538 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4539 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4540 C & gloc(itheta+nphi-2,icg)
4543 C Ufff.... We've done all this!!!
4546 C---------------------------------------------------------------------------
4547 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4549 implicit real*8 (a-h,o-z)
4550 include 'DIMENSIONS'
4551 include 'COMMON.LOCAL'
4552 include 'COMMON.IOUNITS'
4553 common /calcthet/ term1,term2,termm,diffak,ratak,
4554 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4555 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4556 C Calculate the contributions to both Gaussian lobes.
4557 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4558 C The "polynomial part" of the "standard deviation" of this part of
4562 sig=sig*thet_pred_mean+polthet(j,it)
4564 C Derivative of the "interior part" of the "standard deviation of the"
4565 C gamma-dependent Gaussian lobe in t_c.
4566 sigtc=3*polthet(3,it)
4568 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4571 C Set the parameters of both Gaussian lobes of the distribution.
4572 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4573 fac=sig*sig+sigc0(it)
4576 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4577 sigsqtc=-4.0D0*sigcsq*sigtc
4578 c print *,i,sig,sigtc,sigsqtc
4579 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4580 sigtc=-sigtc/(fac*fac)
4581 C Following variable is sigma(t_c)**(-2)
4582 sigcsq=sigcsq*sigcsq
4584 sig0inv=1.0D0/sig0i**2
4585 delthec=thetai-thet_pred_mean
4586 delthe0=thetai-theta0i
4587 term1=-0.5D0*sigcsq*delthec*delthec
4588 term2=-0.5D0*sig0inv*delthe0*delthe0
4589 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4590 C NaNs in taking the logarithm. We extract the largest exponent which is added
4591 C to the energy (this being the log of the distribution) at the end of energy
4592 C term evaluation for this virtual-bond angle.
4593 if (term1.gt.term2) then
4595 term2=dexp(term2-termm)
4599 term1=dexp(term1-termm)
4602 C The ratio between the gamma-independent and gamma-dependent lobes of
4603 C the distribution is a Gaussian function of thet_pred_mean too.
4604 diffak=gthet(2,it)-thet_pred_mean
4605 ratak=diffak/gthet(3,it)**2
4606 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4607 C Let's differentiate it in thet_pred_mean NOW.
4609 C Now put together the distribution terms to make complete distribution.
4610 termexp=term1+ak*term2
4611 termpre=sigc+ak*sig0i
4612 C Contribution of the bending energy from this theta is just the -log of
4613 C the sum of the contributions from the two lobes and the pre-exponential
4614 C factor. Simple enough, isn't it?
4615 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4616 C NOW the derivatives!!!
4617 C 6/6/97 Take into account the deformation.
4618 E_theta=(delthec*sigcsq*term1
4619 & +ak*delthe0*sig0inv*term2)/termexp
4620 E_tc=((sigtc+aktc*sig0i)/termpre
4621 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4622 & aktc*term2)/termexp)
4625 c-----------------------------------------------------------------------------
4626 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4627 implicit real*8 (a-h,o-z)
4628 include 'DIMENSIONS'
4629 include 'COMMON.LOCAL'
4630 include 'COMMON.IOUNITS'
4631 common /calcthet/ term1,term2,termm,diffak,ratak,
4632 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4633 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4634 delthec=thetai-thet_pred_mean
4635 delthe0=thetai-theta0i
4636 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4637 t3 = thetai-thet_pred_mean
4641 t14 = t12+t6*sigsqtc
4643 t21 = thetai-theta0i
4649 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4650 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4651 & *(-t12*t9-ak*sig0inv*t27)
4655 C--------------------------------------------------------------------------
4656 subroutine ebend(etheta)
4658 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4659 C angles gamma and its derivatives in consecutive thetas and gammas.
4660 C ab initio-derived potentials from
4661 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4663 implicit real*8 (a-h,o-z)
4664 include 'DIMENSIONS'
4665 include 'DIMENSIONS.ZSCOPT'
4666 include 'COMMON.LOCAL'
4667 include 'COMMON.GEO'
4668 include 'COMMON.INTERACT'
4669 include 'COMMON.DERIV'
4670 include 'COMMON.VAR'
4671 include 'COMMON.CHAIN'
4672 include 'COMMON.IOUNITS'
4673 include 'COMMON.NAMES'
4674 include 'COMMON.FFIELD'
4675 include 'COMMON.CONTROL'
4676 include 'COMMON.TORCNSTR'
4677 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4678 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4679 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4680 & sinph1ph2(maxdouble,maxdouble)
4681 logical lprn /.false./, lprn1 /.false./
4683 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4684 do i=ithet_start,ithet_end
4686 C if (itype(i-1).eq.ntyp1) cycle
4688 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4689 & .or.itype(i).eq.ntyp1) cycle
4690 if (iabs(itype(i+1)).eq.20) iblock=2
4691 if (iabs(itype(i+1)).ne.20) iblock=1
4695 theti2=0.5d0*theta(i)
4696 ityp2=ithetyp((itype(i-1)))
4698 coskt(k)=dcos(k*theti2)
4699 sinkt(k)=dsin(k*theti2)
4709 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4712 if (phii.ne.phii) phii=150.0
4716 ityp1=ithetyp((itype(i-2)))
4718 cosph1(k)=dcos(k*phii)
4719 sinph1(k)=dsin(k*phii)
4725 ityp1=ithetyp((itype(i-2)))
4731 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4734 if (phii1.ne.phii1) phii1=150.0
4739 ityp3=ithetyp((itype(i)))
4741 cosph2(k)=dcos(k*phii1)
4742 sinph2(k)=dsin(k*phii1)
4747 ityp3=ithetyp((itype(i)))
4753 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4754 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4756 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4759 ccl=cosph1(l)*cosph2(k-l)
4760 ssl=sinph1(l)*sinph2(k-l)
4761 scl=sinph1(l)*cosph2(k-l)
4762 csl=cosph1(l)*sinph2(k-l)
4763 cosph1ph2(l,k)=ccl-ssl
4764 cosph1ph2(k,l)=ccl+ssl
4765 sinph1ph2(l,k)=scl+csl
4766 sinph1ph2(k,l)=scl-csl
4770 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4771 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4772 write (iout,*) "coskt and sinkt"
4774 write (iout,*) k,coskt(k),sinkt(k)
4778 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4779 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4782 & write (iout,*) "k",k,"
4783 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4784 & " ethetai",ethetai
4787 write (iout,*) "cosph and sinph"
4789 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4791 write (iout,*) "cosph1ph2 and sinph2ph2"
4794 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4795 & sinph1ph2(l,k),sinph1ph2(k,l)
4798 write(iout,*) "ethetai",ethetai
4802 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4803 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4804 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4805 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4806 ethetai=ethetai+sinkt(m)*aux
4807 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4808 dephii=dephii+k*sinkt(m)*(
4809 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4810 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4811 dephii1=dephii1+k*sinkt(m)*(
4812 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4813 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4815 & write (iout,*) "m",m," k",k," bbthet",
4816 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4817 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4818 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4819 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4823 & write(iout,*) "ethetai",ethetai
4827 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4828 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4829 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4830 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4831 ethetai=ethetai+sinkt(m)*aux
4832 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4833 dephii=dephii+l*sinkt(m)*(
4834 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4835 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4836 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4837 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4838 dephii1=dephii1+(k-l)*sinkt(m)*(
4839 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4840 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4841 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4842 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4844 write (iout,*) "m",m," k",k," l",l," ffthet",
4845 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4846 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4847 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4848 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4849 & " ethetai",ethetai
4850 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4851 & cosph1ph2(k,l)*sinkt(m),
4852 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4858 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4859 & i,theta(i)*rad2deg,phii*rad2deg,
4860 & phii1*rad2deg,ethetai
4861 etheta=etheta+ethetai
4862 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4863 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4864 c gloc(nphi+i-2,icg)=wang*dethetai
4865 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4871 c-----------------------------------------------------------------------------
4872 subroutine esc(escloc)
4873 C Calculate the local energy of a side chain and its derivatives in the
4874 C corresponding virtual-bond valence angles THETA and the spherical angles
4876 implicit real*8 (a-h,o-z)
4877 include 'DIMENSIONS'
4878 include 'DIMENSIONS.ZSCOPT'
4879 include 'COMMON.GEO'
4880 include 'COMMON.LOCAL'
4881 include 'COMMON.VAR'
4882 include 'COMMON.INTERACT'
4883 include 'COMMON.DERIV'
4884 include 'COMMON.CHAIN'
4885 include 'COMMON.IOUNITS'
4886 include 'COMMON.NAMES'
4887 include 'COMMON.FFIELD'
4888 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4889 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4890 common /sccalc/ time11,time12,time112,theti,it,nlobit
4893 C write (iout,*) 'ESC'
4894 do i=loc_start,loc_end
4896 if (it.eq.ntyp1) cycle
4897 if (it.eq.10) goto 1
4898 nlobit=nlob(iabs(it))
4899 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4900 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4901 theti=theta(i+1)-pipol
4905 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4907 if (x(2).gt.pi-delta) then
4911 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4913 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4914 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4916 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4917 & ddersc0(1),dersc(1))
4918 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4919 & ddersc0(3),dersc(3))
4921 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4923 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4924 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4925 & dersc0(2),esclocbi,dersc02)
4926 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4928 call splinthet(x(2),0.5d0*delta,ss,ssd)
4933 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4935 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4936 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4938 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4940 c write (iout,*) escloci
4941 else if (x(2).lt.delta) then
4945 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4947 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4948 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4950 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4951 & ddersc0(1),dersc(1))
4952 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4953 & ddersc0(3),dersc(3))
4955 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4957 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4958 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4959 & dersc0(2),esclocbi,dersc02)
4960 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4965 call splinthet(x(2),0.5d0*delta,ss,ssd)
4967 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4969 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4970 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4972 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4973 C write (iout,*) 'i=',i, escloci
4975 call enesc(x,escloci,dersc,ddummy,.false.)
4978 escloc=escloc+escloci
4979 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4980 write (iout,'(a6,i5,0pf7.3)')
4981 & 'escloc',i,escloci
4983 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4985 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4986 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4991 C---------------------------------------------------------------------------
4992 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4993 implicit real*8 (a-h,o-z)
4994 include 'DIMENSIONS'
4995 include 'COMMON.GEO'
4996 include 'COMMON.LOCAL'
4997 include 'COMMON.IOUNITS'
4998 common /sccalc/ time11,time12,time112,theti,it,nlobit
4999 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5000 double precision contr(maxlob,-1:1)
5002 c write (iout,*) 'it=',it,' nlobit=',nlobit
5006 if (mixed) ddersc(j)=0.0d0
5010 C Because of periodicity of the dependence of the SC energy in omega we have
5011 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5012 C To avoid underflows, first compute & store the exponents.
5020 z(k)=x(k)-censc(k,j,it)
5025 Axk=Axk+gaussc(l,k,j,it)*z(l)
5031 expfac=expfac+Ax(k,j,iii)*z(k)
5039 C As in the case of ebend, we want to avoid underflows in exponentiation and
5040 C subsequent NaNs and INFs in energy calculation.
5041 C Find the largest exponent
5045 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5049 cd print *,'it=',it,' emin=',emin
5051 C Compute the contribution to SC energy and derivatives
5055 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5056 cd print *,'j=',j,' expfac=',expfac
5057 escloc_i=escloc_i+expfac
5059 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5063 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5064 & +gaussc(k,2,j,it))*expfac
5071 dersc(1)=dersc(1)/cos(theti)**2
5072 ddersc(1)=ddersc(1)/cos(theti)**2
5075 escloci=-(dlog(escloc_i)-emin)
5077 dersc(j)=dersc(j)/escloc_i
5081 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5086 C------------------------------------------------------------------------------
5087 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5088 implicit real*8 (a-h,o-z)
5089 include 'DIMENSIONS'
5090 include 'COMMON.GEO'
5091 include 'COMMON.LOCAL'
5092 include 'COMMON.IOUNITS'
5093 common /sccalc/ time11,time12,time112,theti,it,nlobit
5094 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5095 double precision contr(maxlob)
5106 z(k)=x(k)-censc(k,j,it)
5112 Axk=Axk+gaussc(l,k,j,it)*z(l)
5118 expfac=expfac+Ax(k,j)*z(k)
5123 C As in the case of ebend, we want to avoid underflows in exponentiation and
5124 C subsequent NaNs and INFs in energy calculation.
5125 C Find the largest exponent
5128 if (emin.gt.contr(j)) emin=contr(j)
5132 C Compute the contribution to SC energy and derivatives
5136 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5137 escloc_i=escloc_i+expfac
5139 dersc(k)=dersc(k)+Ax(k,j)*expfac
5141 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5142 & +gaussc(1,2,j,it))*expfac
5146 dersc(1)=dersc(1)/cos(theti)**2
5147 dersc12=dersc12/cos(theti)**2
5148 escloci=-(dlog(escloc_i)-emin)
5150 dersc(j)=dersc(j)/escloc_i
5152 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5156 c----------------------------------------------------------------------------------
5157 subroutine esc(escloc)
5158 C Calculate the local energy of a side chain and its derivatives in the
5159 C corresponding virtual-bond valence angles THETA and the spherical angles
5160 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5161 C added by Urszula Kozlowska. 07/11/2007
5163 implicit real*8 (a-h,o-z)
5164 include 'DIMENSIONS'
5165 include 'DIMENSIONS.ZSCOPT'
5166 include 'COMMON.GEO'
5167 include 'COMMON.LOCAL'
5168 include 'COMMON.VAR'
5169 include 'COMMON.SCROT'
5170 include 'COMMON.INTERACT'
5171 include 'COMMON.DERIV'
5172 include 'COMMON.CHAIN'
5173 include 'COMMON.IOUNITS'
5174 include 'COMMON.NAMES'
5175 include 'COMMON.FFIELD'
5176 include 'COMMON.CONTROL'
5177 include 'COMMON.VECTORS'
5178 double precision x_prime(3),y_prime(3),z_prime(3)
5179 & , sumene,dsc_i,dp2_i,x(65),
5180 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5181 & de_dxx,de_dyy,de_dzz,de_dt
5182 double precision s1_t,s1_6_t,s2_t,s2_6_t
5184 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5185 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5186 & dt_dCi(3),dt_dCi1(3)
5187 common /sccalc/ time11,time12,time112,theti,it,nlobit
5190 do i=loc_start,loc_end
5191 if (itype(i).eq.ntyp1) cycle
5192 costtab(i+1) =dcos(theta(i+1))
5193 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5194 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5195 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5196 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5197 cosfac=dsqrt(cosfac2)
5198 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5199 sinfac=dsqrt(sinfac2)
5201 if (it.eq.10) goto 1
5203 C Compute the axes of tghe local cartesian coordinates system; store in
5204 c x_prime, y_prime and z_prime
5211 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5212 C & dc_norm(3,i+nres)
5214 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5215 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5218 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5221 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5222 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5223 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5224 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5225 c & " xy",scalar(x_prime(1),y_prime(1)),
5226 c & " xz",scalar(x_prime(1),z_prime(1)),
5227 c & " yy",scalar(y_prime(1),y_prime(1)),
5228 c & " yz",scalar(y_prime(1),z_prime(1)),
5229 c & " zz",scalar(z_prime(1),z_prime(1))
5231 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5232 C to local coordinate system. Store in xx, yy, zz.
5238 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5239 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5240 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5247 C Compute the energy of the ith side cbain
5249 c write (2,*) "xx",xx," yy",yy," zz",zz
5252 x(j) = sc_parmin(j,it)
5255 Cc diagnostics - remove later
5257 yy1 = dsin(alph(2))*dcos(omeg(2))
5258 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5259 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5260 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5262 C," --- ", xx_w,yy_w,zz_w
5265 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5266 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5268 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5269 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5271 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5272 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5273 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5274 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5275 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5277 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5278 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5279 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5280 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5281 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5283 dsc_i = 0.743d0+x(61)
5285 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5286 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5287 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5288 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5289 s1=(1+x(63))/(0.1d0 + dscp1)
5290 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5291 s2=(1+x(65))/(0.1d0 + dscp2)
5292 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5293 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5294 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5295 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5297 c & dscp1,dscp2,sumene
5298 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5299 escloc = escloc + sumene
5300 c write (2,*) "escloc",escloc
5301 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5303 if (.not. calc_grad) goto 1
5306 C This section to check the numerical derivatives of the energy of ith side
5307 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5308 C #define DEBUG in the code to turn it on.
5310 write (2,*) "sumene =",sumene
5314 write (2,*) xx,yy,zz
5315 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5316 de_dxx_num=(sumenep-sumene)/aincr
5318 write (2,*) "xx+ sumene from enesc=",sumenep
5321 write (2,*) xx,yy,zz
5322 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5323 de_dyy_num=(sumenep-sumene)/aincr
5325 write (2,*) "yy+ sumene from enesc=",sumenep
5328 write (2,*) xx,yy,zz
5329 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5330 de_dzz_num=(sumenep-sumene)/aincr
5332 write (2,*) "zz+ sumene from enesc=",sumenep
5333 costsave=cost2tab(i+1)
5334 sintsave=sint2tab(i+1)
5335 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5336 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5337 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5338 de_dt_num=(sumenep-sumene)/aincr
5339 write (2,*) " t+ sumene from enesc=",sumenep
5340 cost2tab(i+1)=costsave
5341 sint2tab(i+1)=sintsave
5342 C End of diagnostics section.
5345 C Compute the gradient of esc
5347 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5348 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5349 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5350 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5351 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5352 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5353 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5354 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5355 pom1=(sumene3*sint2tab(i+1)+sumene1)
5356 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5357 pom2=(sumene4*cost2tab(i+1)+sumene2)
5358 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5359 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5360 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5361 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5363 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5364 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5365 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5367 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5368 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5369 & +(pom1+pom2)*pom_dx
5371 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5374 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5375 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5376 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5378 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5379 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5380 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5381 & +x(59)*zz**2 +x(60)*xx*zz
5382 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5383 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5384 & +(pom1-pom2)*pom_dy
5386 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5389 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5390 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5391 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5392 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5393 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5394 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5395 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5396 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5398 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5401 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5402 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5403 & +pom1*pom_dt1+pom2*pom_dt2
5405 write(2,*), "de_dt = ", de_dt,de_dt_num
5409 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5410 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5411 cosfac2xx=cosfac2*xx
5412 sinfac2yy=sinfac2*yy
5414 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5416 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5418 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5419 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5420 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5421 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5422 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5423 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5424 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5425 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5426 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5427 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5431 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5432 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5433 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5434 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5437 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5438 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5439 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5441 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5442 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5446 dXX_Ctab(k,i)=dXX_Ci(k)
5447 dXX_C1tab(k,i)=dXX_Ci1(k)
5448 dYY_Ctab(k,i)=dYY_Ci(k)
5449 dYY_C1tab(k,i)=dYY_Ci1(k)
5450 dZZ_Ctab(k,i)=dZZ_Ci(k)
5451 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5452 dXX_XYZtab(k,i)=dXX_XYZ(k)
5453 dYY_XYZtab(k,i)=dYY_XYZ(k)
5454 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5458 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5459 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5460 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5461 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5462 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5464 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5465 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5466 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5467 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5468 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5469 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5470 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5471 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5473 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5474 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5476 C to check gradient call subroutine check_grad
5483 c------------------------------------------------------------------------------
5484 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5486 C This procedure calculates two-body contact function g(rij) and its derivative:
5489 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5492 C where x=(rij-r0ij)/delta
5494 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5497 double precision rij,r0ij,eps0ij,fcont,fprimcont
5498 double precision x,x2,x4,delta
5502 if (x.lt.-1.0D0) then
5505 else if (x.le.1.0D0) then
5508 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5509 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5516 c------------------------------------------------------------------------------
5517 subroutine splinthet(theti,delta,ss,ssder)
5518 implicit real*8 (a-h,o-z)
5519 include 'DIMENSIONS'
5520 include 'DIMENSIONS.ZSCOPT'
5521 include 'COMMON.VAR'
5522 include 'COMMON.GEO'
5525 if (theti.gt.pipol) then
5526 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5528 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5533 c------------------------------------------------------------------------------
5534 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5536 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5537 double precision ksi,ksi2,ksi3,a1,a2,a3
5538 a1=fprim0*delta/(f1-f0)
5544 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5545 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5548 c------------------------------------------------------------------------------
5549 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5551 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5552 double precision ksi,ksi2,ksi3,a1,a2,a3
5557 a2=3*(f1x-f0x)-2*fprim0x*delta
5558 a3=fprim0x*delta-2*(f1x-f0x)
5559 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5562 C-----------------------------------------------------------------------------
5564 C-----------------------------------------------------------------------------
5565 subroutine etor(etors,fact)
5566 implicit real*8 (a-h,o-z)
5567 include 'DIMENSIONS'
5568 include 'DIMENSIONS.ZSCOPT'
5569 include 'COMMON.VAR'
5570 include 'COMMON.GEO'
5571 include 'COMMON.LOCAL'
5572 include 'COMMON.TORSION'
5573 include 'COMMON.INTERACT'
5574 include 'COMMON.DERIV'
5575 include 'COMMON.CHAIN'
5576 include 'COMMON.NAMES'
5577 include 'COMMON.IOUNITS'
5578 include 'COMMON.FFIELD'
5579 include 'COMMON.TORCNSTR'
5581 C Set lprn=.true. for debugging
5585 do i=iphi_start,iphi_end
5586 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5587 & .or. itype(i).eq.ntyp1) cycle
5588 itori=itortyp(itype(i-2))
5589 itori1=itortyp(itype(i-1))
5592 C Proline-Proline pair is a special case...
5593 if (itori.eq.3 .and. itori1.eq.3) then
5594 if (phii.gt.-dwapi3) then
5596 fac=1.0D0/(1.0D0-cosphi)
5597 etorsi=v1(1,3,3)*fac
5598 etorsi=etorsi+etorsi
5599 etors=etors+etorsi-v1(1,3,3)
5600 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5603 v1ij=v1(j+1,itori,itori1)
5604 v2ij=v2(j+1,itori,itori1)
5607 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5608 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5612 v1ij=v1(j,itori,itori1)
5613 v2ij=v2(j,itori,itori1)
5616 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5617 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5621 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5622 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5623 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5624 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5625 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5629 c------------------------------------------------------------------------------
5631 subroutine etor(etors,fact)
5632 implicit real*8 (a-h,o-z)
5633 include 'DIMENSIONS'
5634 include 'DIMENSIONS.ZSCOPT'
5635 include 'COMMON.VAR'
5636 include 'COMMON.GEO'
5637 include 'COMMON.LOCAL'
5638 include 'COMMON.TORSION'
5639 include 'COMMON.INTERACT'
5640 include 'COMMON.DERIV'
5641 include 'COMMON.CHAIN'
5642 include 'COMMON.NAMES'
5643 include 'COMMON.IOUNITS'
5644 include 'COMMON.FFIELD'
5645 include 'COMMON.TORCNSTR'
5647 C Set lprn=.true. for debugging
5651 do i=iphi_start,iphi_end
5653 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5654 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5655 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5656 C & .or. itype(i).eq.ntyp1) cycle
5657 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5658 if (iabs(itype(i)).eq.20) then
5663 itori=itortyp(itype(i-2))
5664 itori1=itortyp(itype(i-1))
5667 C Regular cosine and sine terms
5668 do j=1,nterm(itori,itori1,iblock)
5669 v1ij=v1(j,itori,itori1,iblock)
5670 v2ij=v2(j,itori,itori1,iblock)
5673 etors=etors+v1ij*cosphi+v2ij*sinphi
5674 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5678 C E = SUM ----------------------------------- - v1
5679 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5681 cosphi=dcos(0.5d0*phii)
5682 sinphi=dsin(0.5d0*phii)
5683 do j=1,nlor(itori,itori1,iblock)
5684 vl1ij=vlor1(j,itori,itori1)
5685 vl2ij=vlor2(j,itori,itori1)
5686 vl3ij=vlor3(j,itori,itori1)
5687 pom=vl2ij*cosphi+vl3ij*sinphi
5688 pom1=1.0d0/(pom*pom+1.0d0)
5689 etors=etors+vl1ij*pom1
5690 c if (energy_dec) etors_ii=etors_ii+
5693 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5695 C Subtract the constant term
5696 etors=etors-v0(itori,itori1,iblock)
5698 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5699 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5700 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5701 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5702 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5707 c----------------------------------------------------------------------------
5708 subroutine etor_d(etors_d,fact2)
5709 C 6/23/01 Compute double torsional energy
5710 implicit real*8 (a-h,o-z)
5711 include 'DIMENSIONS'
5712 include 'DIMENSIONS.ZSCOPT'
5713 include 'COMMON.VAR'
5714 include 'COMMON.GEO'
5715 include 'COMMON.LOCAL'
5716 include 'COMMON.TORSION'
5717 include 'COMMON.INTERACT'
5718 include 'COMMON.DERIV'
5719 include 'COMMON.CHAIN'
5720 include 'COMMON.NAMES'
5721 include 'COMMON.IOUNITS'
5722 include 'COMMON.FFIELD'
5723 include 'COMMON.TORCNSTR'
5725 C Set lprn=.true. for debugging
5729 do i=iphi_start,iphi_end-1
5731 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5732 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5733 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5734 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5735 & (itype(i+1).eq.ntyp1)) cycle
5736 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5738 itori=itortyp(itype(i-2))
5739 itori1=itortyp(itype(i-1))
5740 itori2=itortyp(itype(i))
5746 if (iabs(itype(i+1)).eq.20) iblock=2
5747 C Regular cosine and sine terms
5748 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5749 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5750 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5751 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5752 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5753 cosphi1=dcos(j*phii)
5754 sinphi1=dsin(j*phii)
5755 cosphi2=dcos(j*phii1)
5756 sinphi2=dsin(j*phii1)
5757 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5758 & v2cij*cosphi2+v2sij*sinphi2
5759 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5760 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5762 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5764 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5765 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5766 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5767 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5768 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5769 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5770 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5771 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5772 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5773 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5774 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5775 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5776 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5777 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5780 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5781 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5787 c---------------------------------------------------------------------------
5788 C The rigorous attempt to derive energy function
5789 subroutine etor_kcc(etors,fact)
5790 implicit real*8 (a-h,o-z)
5791 include 'DIMENSIONS'
5792 include 'DIMENSIONS.ZSCOPT'
5793 include 'COMMON.VAR'
5794 include 'COMMON.GEO'
5795 include 'COMMON.LOCAL'
5796 include 'COMMON.TORSION'
5797 include 'COMMON.INTERACT'
5798 include 'COMMON.DERIV'
5799 include 'COMMON.CHAIN'
5800 include 'COMMON.NAMES'
5801 include 'COMMON.IOUNITS'
5802 include 'COMMON.FFIELD'
5803 include 'COMMON.TORCNSTR'
5804 include 'COMMON.CONTROL'
5805 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
5807 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
5808 C Set lprn=.true. for debugging
5811 C print *,"wchodze kcc"
5812 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
5814 do i=iphi_start,iphi_end
5815 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5816 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5817 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5818 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5819 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5820 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5821 itori=itortyp(itype(i-2))
5822 itori1=itortyp(itype(i-1))
5827 C to avoid multiple devision by 2
5828 c theti22=0.5d0*theta(i)
5829 C theta 12 is the theta_1 /2
5830 C theta 22 is theta_2 /2
5831 c theti12=0.5d0*theta(i-1)
5832 C and appropriate sinus function
5833 sinthet1=dsin(theta(i-1))
5834 sinthet2=dsin(theta(i))
5835 costhet1=dcos(theta(i-1))
5836 costhet2=dcos(theta(i))
5837 C to speed up lets store its mutliplication
5838 sint1t2=sinthet2*sinthet1
5840 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
5841 C +d_n*sin(n*gamma)) *
5842 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
5843 C we have two sum 1) Non-Chebyshev which is with n and gamma
5844 nval=nterm_kcc_Tb(itori,itori1)
5850 c1(j)=c1(j-1)*costhet1
5851 c2(j)=c2(j-1)*costhet2
5854 do j=1,nterm_kcc(itori,itori1)
5858 sint1t2n=sint1t2n*sint1t2
5864 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5865 gradvalct1=gradvalct1+
5866 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5867 gradvalct2=gradvalct2+
5868 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5871 gradvalct1=-gradvalct1*sinthet1
5872 gradvalct2=-gradvalct2*sinthet2
5878 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5879 gradvalst1=gradvalst1+
5880 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5881 gradvalst2=gradvalst2+
5882 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5885 gradvalst1=-gradvalst1*sinthet1
5886 gradvalst2=-gradvalst2*sinthet2
5887 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
5888 C glocig is the gradient local i site in gamma
5889 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
5890 C now gradient over theta_1
5891 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
5892 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
5893 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
5894 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
5897 C derivative over gamma
5898 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
5899 C derivative over theta1
5900 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
5901 C now derivative over theta2
5902 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
5904 write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
5905 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
5906 write (iout,*) "c1",(c1(k),k=0,nval),
5907 & " c2",(c2(k),k=0,nval)
5908 write (iout,*) "sumvalc",sumvalc," sumvals",sumvals
5913 c---------------------------------------------------------------------------------------------
5914 subroutine etor_constr(edihcnstr)
5915 implicit real*8 (a-h,o-z)
5916 include 'DIMENSIONS'
5917 include 'DIMENSIONS.ZSCOPT'
5918 include 'COMMON.VAR'
5919 include 'COMMON.GEO'
5920 include 'COMMON.LOCAL'
5921 include 'COMMON.TORSION'
5922 include 'COMMON.INTERACT'
5923 include 'COMMON.DERIV'
5924 include 'COMMON.CHAIN'
5925 include 'COMMON.NAMES'
5926 include 'COMMON.IOUNITS'
5927 include 'COMMON.FFIELD'
5928 include 'COMMON.TORCNSTR'
5929 include 'COMMON.CONTROL'
5930 ! 6/20/98 - dihedral angle constraints
5932 c do i=1,ndih_constr
5933 c write (iout,*) "idihconstr_start",idihconstr_start,
5934 c & " idihconstr_end",idihconstr_end
5936 if (raw_psipred) then
5937 do i=idihconstr_start,idihconstr_end
5938 itori=idih_constr(i)
5940 gaudih_i=vpsipred(1,i)
5944 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
5945 dexpcos_i=dexp(-cos_i*cos_i)
5946 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
5947 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
5948 & *cos_i*dexpcos_i/s**2
5950 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
5951 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
5953 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
5954 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
5955 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
5956 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
5957 & -wdihc*dlog(gaudih_i)
5961 do i=idihconstr_start,idihconstr_end
5962 itori=idih_constr(i)
5964 difi=pinorm(phii-phi0(i))
5965 if (difi.gt.drange(i)) then
5967 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5968 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5969 else if (difi.lt.-drange(i)) then
5971 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5972 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5980 c write (iout,*) "ETOR_CONSTR",edihcnstr
5983 c----------------------------------------------------------------------------
5984 C The rigorous attempt to derive energy function
5985 subroutine ebend_kcc(etheta)
5987 implicit real*8 (a-h,o-z)
5988 include 'DIMENSIONS'
5989 include 'DIMENSIONS.ZSCOPT'
5990 include 'COMMON.VAR'
5991 include 'COMMON.GEO'
5992 include 'COMMON.LOCAL'
5993 include 'COMMON.TORSION'
5994 include 'COMMON.INTERACT'
5995 include 'COMMON.DERIV'
5996 include 'COMMON.CHAIN'
5997 include 'COMMON.NAMES'
5998 include 'COMMON.IOUNITS'
5999 include 'COMMON.FFIELD'
6000 include 'COMMON.TORCNSTR'
6001 include 'COMMON.CONTROL'
6003 double precision thybt1(maxang_kcc)
6004 C Set lprn=.true. for debugging
6007 C print *,"wchodze kcc"
6008 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6010 do i=ithet_start,ithet_end
6011 c print *,i,itype(i-1),itype(i),itype(i-2)
6012 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6013 & .or.itype(i).eq.ntyp1) cycle
6014 iti=iabs(itortyp(itype(i-1)))
6015 sinthet=dsin(theta(i))
6016 costhet=dcos(theta(i))
6017 do j=1,nbend_kcc_Tb(iti)
6018 thybt1(j)=v1bend_chyb(j,iti)
6020 sumth1thyb=v1bend_chyb(0,iti)+
6021 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6022 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6024 ihelp=nbend_kcc_Tb(iti)-1
6025 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6026 etheta=etheta+sumth1thyb
6027 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6028 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6032 c-------------------------------------------------------------------------------------
6033 subroutine etheta_constr(ethetacnstr)
6035 implicit real*8 (a-h,o-z)
6036 include 'DIMENSIONS'
6037 include 'DIMENSIONS.ZSCOPT'
6038 include 'COMMON.VAR'
6039 include 'COMMON.GEO'
6040 include 'COMMON.LOCAL'
6041 include 'COMMON.TORSION'
6042 include 'COMMON.INTERACT'
6043 include 'COMMON.DERIV'
6044 include 'COMMON.CHAIN'
6045 include 'COMMON.NAMES'
6046 include 'COMMON.IOUNITS'
6047 include 'COMMON.FFIELD'
6048 include 'COMMON.TORCNSTR'
6049 include 'COMMON.CONTROL'
6051 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6052 do i=ithetaconstr_start,ithetaconstr_end
6053 itheta=itheta_constr(i)
6054 thetiii=theta(itheta)
6055 difi=pinorm(thetiii-theta_constr0(i))
6056 if (difi.gt.theta_drange(i)) then
6057 difi=difi-theta_drange(i)
6058 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6059 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6060 & +for_thet_constr(i)*difi**3
6061 else if (difi.lt.-drange(i)) then
6063 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6064 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6065 & +for_thet_constr(i)*difi**3
6069 if (energy_dec) then
6070 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6071 & i,itheta,rad2deg*thetiii,
6072 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6073 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6074 & gloc(itheta+nphi-2,icg)
6079 c------------------------------------------------------------------------------
6080 c------------------------------------------------------------------------------
6081 subroutine eback_sc_corr(esccor)
6082 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6083 c conformational states; temporarily implemented as differences
6084 c between UNRES torsional potentials (dependent on three types of
6085 c residues) and the torsional potentials dependent on all 20 types
6086 c of residues computed from AM1 energy surfaces of terminally-blocked
6087 c amino-acid residues.
6088 implicit real*8 (a-h,o-z)
6089 include 'DIMENSIONS'
6090 include 'DIMENSIONS.ZSCOPT'
6091 include 'COMMON.VAR'
6092 include 'COMMON.GEO'
6093 include 'COMMON.LOCAL'
6094 include 'COMMON.TORSION'
6095 include 'COMMON.SCCOR'
6096 include 'COMMON.INTERACT'
6097 include 'COMMON.DERIV'
6098 include 'COMMON.CHAIN'
6099 include 'COMMON.NAMES'
6100 include 'COMMON.IOUNITS'
6101 include 'COMMON.FFIELD'
6102 include 'COMMON.CONTROL'
6104 C Set lprn=.true. for debugging
6107 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6109 do i=itau_start,itau_end
6110 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6112 isccori=isccortyp(itype(i-2))
6113 isccori1=isccortyp(itype(i-1))
6115 do intertyp=1,3 !intertyp
6116 cc Added 09 May 2012 (Adasko)
6117 cc Intertyp means interaction type of backbone mainchain correlation:
6118 c 1 = SC...Ca...Ca...Ca
6119 c 2 = Ca...Ca...Ca...SC
6120 c 3 = SC...Ca...Ca...SCi
6122 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6123 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6124 & (itype(i-1).eq.ntyp1)))
6125 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6126 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6127 & .or.(itype(i).eq.ntyp1)))
6128 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6129 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6130 & (itype(i-3).eq.ntyp1)))) cycle
6131 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6132 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6134 do j=1,nterm_sccor(isccori,isccori1)
6135 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6136 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6137 cosphi=dcos(j*tauangle(intertyp,i))
6138 sinphi=dsin(j*tauangle(intertyp,i))
6139 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6140 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6142 C write (iout,*)"EBACK_SC_COR",esccor,i
6143 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6144 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6145 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6147 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6148 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6149 & (v1sccor(j,1,itori,itori1),j=1,6)
6150 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6151 c gsccor_loc(i-3)=gloci
6156 c------------------------------------------------------------------------------
6157 subroutine multibody(ecorr)
6158 C This subroutine calculates multi-body contributions to energy following
6159 C the idea of Skolnick et al. If side chains I and J make a contact and
6160 C at the same time side chains I+1 and J+1 make a contact, an extra
6161 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6162 implicit real*8 (a-h,o-z)
6163 include 'DIMENSIONS'
6164 include 'COMMON.IOUNITS'
6165 include 'COMMON.DERIV'
6166 include 'COMMON.INTERACT'
6167 include 'COMMON.CONTACTS'
6168 double precision gx(3),gx1(3)
6171 C Set lprn=.true. for debugging
6175 write (iout,'(a)') 'Contact function values:'
6177 write (iout,'(i2,20(1x,i2,f10.5))')
6178 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6193 num_conti=num_cont(i)
6194 num_conti1=num_cont(i1)
6199 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6200 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6201 cd & ' ishift=',ishift
6202 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6203 C The system gains extra energy.
6204 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6205 endif ! j1==j+-ishift
6214 c------------------------------------------------------------------------------
6215 double precision function esccorr(i,j,k,l,jj,kk)
6216 implicit real*8 (a-h,o-z)
6217 include 'DIMENSIONS'
6218 include 'COMMON.IOUNITS'
6219 include 'COMMON.DERIV'
6220 include 'COMMON.INTERACT'
6221 include 'COMMON.CONTACTS'
6222 double precision gx(3),gx1(3)
6227 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6228 C Calculate the multi-body contribution to energy.
6229 C Calculate multi-body contributions to the gradient.
6230 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6231 cd & k,l,(gacont(m,kk,k),m=1,3)
6233 gx(m) =ekl*gacont(m,jj,i)
6234 gx1(m)=eij*gacont(m,kk,k)
6235 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6236 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6237 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6238 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6242 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6247 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6253 c------------------------------------------------------------------------------
6254 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6255 C This subroutine calculates multi-body contributions to hydrogen-bonding
6256 implicit real*8 (a-h,o-z)
6257 include 'DIMENSIONS'
6258 include 'DIMENSIONS.ZSCOPT'
6259 include 'COMMON.IOUNITS'
6260 include 'COMMON.FFIELD'
6261 include 'COMMON.DERIV'
6262 include 'COMMON.INTERACT'
6263 include 'COMMON.CONTACTS'
6264 double precision gx(3),gx1(3)
6267 C Set lprn=.true. for debugging
6270 write (iout,'(a)') 'Contact function values:'
6272 write (iout,'(2i3,50(1x,i2,f5.2))')
6273 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6274 & j=1,num_cont_hb(i))
6278 C Remove the loop below after debugging !!!
6285 C Calculate the local-electrostatic correlation terms
6286 do i=iatel_s,iatel_e+1
6288 num_conti=num_cont_hb(i)
6289 num_conti1=num_cont_hb(i+1)
6294 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6295 c & ' jj=',jj,' kk=',kk
6296 if (j1.eq.j+1 .or. j1.eq.j-1) then
6297 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6298 C The system gains extra energy.
6299 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6301 else if (j1.eq.j) then
6302 C Contacts I-J and I-(J+1) occur simultaneously.
6303 C The system loses extra energy.
6304 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6309 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6310 c & ' jj=',jj,' kk=',kk
6312 C Contacts I-J and (I+1)-J occur simultaneously.
6313 C The system loses extra energy.
6314 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6321 c------------------------------------------------------------------------------
6322 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6324 C This subroutine calculates multi-body contributions to hydrogen-bonding
6325 implicit real*8 (a-h,o-z)
6326 include 'DIMENSIONS'
6327 include 'DIMENSIONS.ZSCOPT'
6328 include 'COMMON.IOUNITS'
6332 include 'COMMON.FFIELD'
6333 include 'COMMON.DERIV'
6334 include 'COMMON.LOCAL'
6335 include 'COMMON.INTERACT'
6336 include 'COMMON.CONTACTS'
6337 include 'COMMON.CHAIN'
6338 include 'COMMON.CONTROL'
6339 include 'COMMON.SHIELD'
6340 double precision gx(3),gx1(3)
6341 integer num_cont_hb_old(maxres)
6343 double precision eello4,eello5,eelo6,eello_turn6
6344 external eello4,eello5,eello6,eello_turn6
6345 C Set lprn=.true. for debugging
6349 write (iout,'(a)') 'Contact function values:'
6351 write (iout,'(2i3,50(1x,i2,5f6.3))')
6352 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6353 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6359 C Remove the loop below after debugging !!!
6366 C Calculate the dipole-dipole interaction energies
6367 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6368 do i=iatel_s,iatel_e+1
6369 num_conti=num_cont_hb(i)
6378 C Calculate the local-electrostatic correlation terms
6379 c write (iout,*) "gradcorr5 in eello5 before loop"
6381 c write (iout,'(i5,3f10.5)')
6382 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6384 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6385 c write (iout,*) "corr loop i",i
6387 num_conti=num_cont_hb(i)
6388 num_conti1=num_cont_hb(i+1)
6395 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6396 c & ' jj=',jj,' kk=',kk
6397 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6398 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6399 & .or. j.lt.0 .and. j1.gt.0) .and.
6400 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6401 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6402 C The system gains extra energy.
6404 sqd1=dsqrt(d_cont(jj,i))
6405 sqd2=dsqrt(d_cont(kk,i1))
6406 sred_geom = sqd1*sqd2
6407 IF (sred_geom.lt.cutoff_corr) THEN
6408 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6410 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6411 cd & ' jj=',jj,' kk=',kk
6412 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6413 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6415 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6416 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6419 cd write (iout,*) 'sred_geom=',sred_geom,
6420 cd & ' ekont=',ekont,' fprim=',fprimcont,
6421 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6422 cd write (iout,*) "g_contij",g_contij
6423 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6424 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6425 call calc_eello(i,jp,i+1,jp1,jj,kk)
6426 if (wcorr4.gt.0.0d0)
6427 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6428 CC & *fac_shield(i)**2*fac_shield(j)**2
6429 if (energy_dec.and.wcorr4.gt.0.0d0)
6430 1 write (iout,'(a6,4i5,0pf7.3)')
6431 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6432 c write (iout,*) "gradcorr5 before eello5"
6434 c write (iout,'(i5,3f10.5)')
6435 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6437 if (wcorr5.gt.0.0d0)
6438 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6439 c write (iout,*) "gradcorr5 after eello5"
6441 c write (iout,'(i5,3f10.5)')
6442 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6444 if (energy_dec.and.wcorr5.gt.0.0d0)
6445 1 write (iout,'(a6,4i5,0pf7.3)')
6446 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6447 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6448 cd write(2,*)'ijkl',i,jp,i+1,jp1
6449 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6450 & .or. wturn6.eq.0.0d0))then
6451 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6452 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6453 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6454 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6455 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6456 cd & 'ecorr6=',ecorr6
6457 cd write (iout,'(4e15.5)') sred_geom,
6458 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6459 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6460 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6461 else if (wturn6.gt.0.0d0
6462 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6463 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6464 eturn6=eturn6+eello_turn6(i,jj,kk)
6465 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6466 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6467 cd write (2,*) 'multibody_eello:eturn6',eturn6
6476 num_cont_hb(i)=num_cont_hb_old(i)
6478 c write (iout,*) "gradcorr5 in eello5"
6480 c write (iout,'(i5,3f10.5)')
6481 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6485 c------------------------------------------------------------------------------
6486 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6487 implicit real*8 (a-h,o-z)
6488 include 'DIMENSIONS'
6489 include 'DIMENSIONS.ZSCOPT'
6490 include 'COMMON.IOUNITS'
6491 include 'COMMON.DERIV'
6492 include 'COMMON.INTERACT'
6493 include 'COMMON.CONTACTS'
6494 include 'COMMON.SHIELD'
6495 include 'COMMON.CONTROL'
6496 double precision gx(3),gx1(3)
6499 C print *,"wchodze",fac_shield(i),shield_mode
6507 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6509 C & fac_shield(i)**2*fac_shield(j)**2
6510 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6511 C Following 4 lines for diagnostics.
6516 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6517 c & 'Contacts ',i,j,
6518 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6519 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6521 C Calculate the multi-body contribution to energy.
6522 C ecorr=ecorr+ekont*ees
6523 C Calculate multi-body contributions to the gradient.
6524 coeffpees0pij=coeffp*ees0pij
6525 coeffmees0mij=coeffm*ees0mij
6526 coeffpees0pkl=coeffp*ees0pkl
6527 coeffmees0mkl=coeffm*ees0mkl
6529 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6530 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6531 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6532 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6533 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6534 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6535 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6536 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6537 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6538 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6539 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6540 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6541 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6542 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6543 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6544 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6545 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6546 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6547 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6548 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6549 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6550 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6551 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6552 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6553 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6558 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6559 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6560 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6561 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6566 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6567 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6568 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6569 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6572 c write (iout,*) "ehbcorr",ekont*ees
6573 C print *,ekont,ees,i,k
6575 C now gradient over shielding
6577 if (shield_mode.gt.0) then
6580 C print *,i,j,fac_shield(i),fac_shield(j),
6581 C &fac_shield(k),fac_shield(l)
6582 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6583 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6584 do ilist=1,ishield_list(i)
6585 iresshield=shield_list(ilist,i)
6587 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6589 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6591 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6592 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6596 do ilist=1,ishield_list(j)
6597 iresshield=shield_list(ilist,j)
6599 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6601 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6603 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6604 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6609 do ilist=1,ishield_list(k)
6610 iresshield=shield_list(ilist,k)
6612 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6614 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6616 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6617 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6621 do ilist=1,ishield_list(l)
6622 iresshield=shield_list(ilist,l)
6624 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6626 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6628 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6629 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6633 C print *,gshieldx(m,iresshield)
6635 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6636 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6637 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6638 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6639 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6640 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6641 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6642 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6644 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6645 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6646 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6647 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6648 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6649 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6650 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6651 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6659 C---------------------------------------------------------------------------
6660 subroutine dipole(i,j,jj)
6661 implicit real*8 (a-h,o-z)
6662 include 'DIMENSIONS'
6663 include 'DIMENSIONS.ZSCOPT'
6664 include 'COMMON.IOUNITS'
6665 include 'COMMON.CHAIN'
6666 include 'COMMON.FFIELD'
6667 include 'COMMON.DERIV'
6668 include 'COMMON.INTERACT'
6669 include 'COMMON.CONTACTS'
6670 include 'COMMON.TORSION'
6671 include 'COMMON.VAR'
6672 include 'COMMON.GEO'
6673 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6675 iti1 = itortyp(itype(i+1))
6676 if (j.lt.nres-1) then
6677 itj1 = itype2loc(itype(j+1))
6682 dipi(iii,1)=Ub2(iii,i)
6683 dipderi(iii)=Ub2der(iii,i)
6684 dipi(iii,2)=b1(iii,i+1)
6685 dipj(iii,1)=Ub2(iii,j)
6686 dipderj(iii)=Ub2der(iii,j)
6687 dipj(iii,2)=b1(iii,j+1)
6691 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6694 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6701 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6705 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6710 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6711 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6713 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6715 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6717 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6722 C---------------------------------------------------------------------------
6723 subroutine calc_eello(i,j,k,l,jj,kk)
6725 C This subroutine computes matrices and vectors needed to calculate
6726 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6728 implicit real*8 (a-h,o-z)
6729 include 'DIMENSIONS'
6730 include 'DIMENSIONS.ZSCOPT'
6731 include 'COMMON.IOUNITS'
6732 include 'COMMON.CHAIN'
6733 include 'COMMON.DERIV'
6734 include 'COMMON.INTERACT'
6735 include 'COMMON.CONTACTS'
6736 include 'COMMON.TORSION'
6737 include 'COMMON.VAR'
6738 include 'COMMON.GEO'
6739 include 'COMMON.FFIELD'
6740 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6741 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6744 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6745 cd & ' jj=',jj,' kk=',kk
6746 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6747 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6748 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6751 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6752 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6755 call transpose2(aa1(1,1),aa1t(1,1))
6756 call transpose2(aa2(1,1),aa2t(1,1))
6759 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6760 & aa1tder(1,1,lll,kkk))
6761 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6762 & aa2tder(1,1,lll,kkk))
6766 C parallel orientation of the two CA-CA-CA frames.
6768 iti=itype2loc(itype(i))
6772 itk1=itype2loc(itype(k+1))
6773 itj=itype2loc(itype(j))
6774 if (l.lt.nres-1) then
6775 itl1=itype2loc(itype(l+1))
6779 C A1 kernel(j+1) A2T
6781 cd write (iout,'(3f10.5,5x,3f10.5)')
6782 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6784 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6785 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6786 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6787 C Following matrices are needed only for 6-th order cumulants
6788 IF (wcorr6.gt.0.0d0) THEN
6789 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6790 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6791 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6792 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6793 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6794 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6795 & ADtEAderx(1,1,1,1,1,1))
6797 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6798 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6799 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6800 & ADtEA1derx(1,1,1,1,1,1))
6802 C End 6-th order cumulants
6805 cd write (2,*) 'In calc_eello6'
6807 cd write (2,*) 'iii=',iii
6809 cd write (2,*) 'kkk=',kkk
6811 cd write (2,'(3(2f10.5),5x)')
6812 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6817 call transpose2(EUgder(1,1,k),auxmat(1,1))
6818 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6819 call transpose2(EUg(1,1,k),auxmat(1,1))
6820 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6821 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6825 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6826 & EAEAderx(1,1,lll,kkk,iii,1))
6830 C A1T kernel(i+1) A2
6831 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6832 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6833 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6834 C Following matrices are needed only for 6-th order cumulants
6835 IF (wcorr6.gt.0.0d0) THEN
6836 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6837 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6838 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6839 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6840 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6841 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6842 & ADtEAderx(1,1,1,1,1,2))
6843 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6844 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6845 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6846 & ADtEA1derx(1,1,1,1,1,2))
6848 C End 6-th order cumulants
6849 call transpose2(EUgder(1,1,l),auxmat(1,1))
6850 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6851 call transpose2(EUg(1,1,l),auxmat(1,1))
6852 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6853 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6857 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6858 & EAEAderx(1,1,lll,kkk,iii,2))
6863 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6864 C They are needed only when the fifth- or the sixth-order cumulants are
6866 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6867 call transpose2(AEA(1,1,1),auxmat(1,1))
6868 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
6869 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6870 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6871 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6872 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
6873 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6874 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
6875 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
6876 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6877 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6878 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6879 call transpose2(AEA(1,1,2),auxmat(1,1))
6880 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
6881 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6882 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6883 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6884 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
6885 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6886 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
6887 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
6888 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6889 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6890 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6891 C Calculate the Cartesian derivatives of the vectors.
6895 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6896 call matvec2(auxmat(1,1),b1(1,i),
6897 & AEAb1derx(1,lll,kkk,iii,1,1))
6898 call matvec2(auxmat(1,1),Ub2(1,i),
6899 & AEAb2derx(1,lll,kkk,iii,1,1))
6900 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
6901 & AEAb1derx(1,lll,kkk,iii,2,1))
6902 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6903 & AEAb2derx(1,lll,kkk,iii,2,1))
6904 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6905 call matvec2(auxmat(1,1),b1(1,j),
6906 & AEAb1derx(1,lll,kkk,iii,1,2))
6907 call matvec2(auxmat(1,1),Ub2(1,j),
6908 & AEAb2derx(1,lll,kkk,iii,1,2))
6909 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
6910 & AEAb1derx(1,lll,kkk,iii,2,2))
6911 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6912 & AEAb2derx(1,lll,kkk,iii,2,2))
6919 C Antiparallel orientation of the two CA-CA-CA frames.
6921 iti=itype2loc(itype(i))
6925 itk1=itype2loc(itype(k+1))
6926 itl=itype2loc(itype(l))
6927 itj=itype2loc(itype(j))
6928 if (j.lt.nres-1) then
6929 itj1=itype2loc(itype(j+1))
6933 C A2 kernel(j-1)T A1T
6934 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6935 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6936 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6937 C Following matrices are needed only for 6-th order cumulants
6938 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6939 & j.eq.i+4 .and. l.eq.i+3)) THEN
6940 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6941 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6942 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6943 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6944 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6945 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6946 & ADtEAderx(1,1,1,1,1,1))
6947 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6948 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6949 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6950 & ADtEA1derx(1,1,1,1,1,1))
6952 C End 6-th order cumulants
6953 call transpose2(EUgder(1,1,k),auxmat(1,1))
6954 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6955 call transpose2(EUg(1,1,k),auxmat(1,1))
6956 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6957 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6961 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6962 & EAEAderx(1,1,lll,kkk,iii,1))
6966 C A2T kernel(i+1)T A1
6967 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6968 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6969 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6970 C Following matrices are needed only for 6-th order cumulants
6971 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6972 & j.eq.i+4 .and. l.eq.i+3)) THEN
6973 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6974 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6975 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6976 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6977 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6978 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6979 & ADtEAderx(1,1,1,1,1,2))
6980 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6981 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6982 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6983 & ADtEA1derx(1,1,1,1,1,2))
6985 C End 6-th order cumulants
6986 call transpose2(EUgder(1,1,j),auxmat(1,1))
6987 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6988 call transpose2(EUg(1,1,j),auxmat(1,1))
6989 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6990 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6994 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6995 & EAEAderx(1,1,lll,kkk,iii,2))
7000 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7001 C They are needed only when the fifth- or the sixth-order cumulants are
7003 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7004 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7005 call transpose2(AEA(1,1,1),auxmat(1,1))
7006 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7007 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7008 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7009 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7010 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7011 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7012 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7013 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7014 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7015 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7016 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7017 call transpose2(AEA(1,1,2),auxmat(1,1))
7018 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7019 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7020 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7021 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7022 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7023 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7024 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7025 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7026 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7027 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7028 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7029 C Calculate the Cartesian derivatives of the vectors.
7033 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7034 call matvec2(auxmat(1,1),b1(1,i),
7035 & AEAb1derx(1,lll,kkk,iii,1,1))
7036 call matvec2(auxmat(1,1),Ub2(1,i),
7037 & AEAb2derx(1,lll,kkk,iii,1,1))
7038 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7039 & AEAb1derx(1,lll,kkk,iii,2,1))
7040 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7041 & AEAb2derx(1,lll,kkk,iii,2,1))
7042 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7043 call matvec2(auxmat(1,1),b1(1,l),
7044 & AEAb1derx(1,lll,kkk,iii,1,2))
7045 call matvec2(auxmat(1,1),Ub2(1,l),
7046 & AEAb2derx(1,lll,kkk,iii,1,2))
7047 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7048 & AEAb1derx(1,lll,kkk,iii,2,2))
7049 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7050 & AEAb2derx(1,lll,kkk,iii,2,2))
7059 C---------------------------------------------------------------------------
7060 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7061 & KK,KKderg,AKA,AKAderg,AKAderx)
7065 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7066 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7067 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7072 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7074 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7077 cd if (lprn) write (2,*) 'In kernel'
7079 cd if (lprn) write (2,*) 'kkk=',kkk
7081 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7082 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7084 cd write (2,*) 'lll=',lll
7085 cd write (2,*) 'iii=1'
7087 cd write (2,'(3(2f10.5),5x)')
7088 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7091 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7092 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7094 cd write (2,*) 'lll=',lll
7095 cd write (2,*) 'iii=2'
7097 cd write (2,'(3(2f10.5),5x)')
7098 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7105 C---------------------------------------------------------------------------
7106 double precision function eello4(i,j,k,l,jj,kk)
7107 implicit real*8 (a-h,o-z)
7108 include 'DIMENSIONS'
7109 include 'DIMENSIONS.ZSCOPT'
7110 include 'COMMON.IOUNITS'
7111 include 'COMMON.CHAIN'
7112 include 'COMMON.DERIV'
7113 include 'COMMON.INTERACT'
7114 include 'COMMON.CONTACTS'
7115 include 'COMMON.TORSION'
7116 include 'COMMON.VAR'
7117 include 'COMMON.GEO'
7118 double precision pizda(2,2),ggg1(3),ggg2(3)
7119 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7123 cd print *,'eello4:',i,j,k,l,jj,kk
7124 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7125 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7126 cold eij=facont_hb(jj,i)
7127 cold ekl=facont_hb(kk,k)
7129 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7131 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7132 gcorr_loc(k-1)=gcorr_loc(k-1)
7133 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7135 gcorr_loc(l-1)=gcorr_loc(l-1)
7136 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7138 gcorr_loc(j-1)=gcorr_loc(j-1)
7139 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7144 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7145 & -EAEAderx(2,2,lll,kkk,iii,1)
7146 cd derx(lll,kkk,iii)=0.0d0
7150 cd gcorr_loc(l-1)=0.0d0
7151 cd gcorr_loc(j-1)=0.0d0
7152 cd gcorr_loc(k-1)=0.0d0
7154 cd write (iout,*)'Contacts have occurred for peptide groups',
7155 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7156 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7157 if (j.lt.nres-1) then
7164 if (l.lt.nres-1) then
7172 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7173 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7174 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7175 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7176 cgrad ghalf=0.5d0*ggg1(ll)
7177 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7178 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7179 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7180 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7181 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7182 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7183 cgrad ghalf=0.5d0*ggg2(ll)
7184 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7185 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7186 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7187 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7188 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7189 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7193 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7198 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7203 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7208 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7212 cd write (2,*) iii,gcorr_loc(iii)
7216 cd write (2,*) 'ekont',ekont
7217 cd write (iout,*) 'eello4',ekont*eel4
7220 C---------------------------------------------------------------------------
7221 double precision function eello5(i,j,k,l,jj,kk)
7222 implicit real*8 (a-h,o-z)
7223 include 'DIMENSIONS'
7224 include 'DIMENSIONS.ZSCOPT'
7225 include 'COMMON.IOUNITS'
7226 include 'COMMON.CHAIN'
7227 include 'COMMON.DERIV'
7228 include 'COMMON.INTERACT'
7229 include 'COMMON.CONTACTS'
7230 include 'COMMON.TORSION'
7231 include 'COMMON.VAR'
7232 include 'COMMON.GEO'
7233 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7234 double precision ggg1(3),ggg2(3)
7235 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7240 C /l\ / \ \ / \ / \ / C
7241 C / \ / \ \ / \ / \ / C
7242 C j| o |l1 | o | o| o | | o |o C
7243 C \ |/k\| |/ \| / |/ \| |/ \| C
7244 C \i/ \ / \ / / \ / \ C
7246 C (I) (II) (III) (IV) C
7248 C eello5_1 eello5_2 eello5_3 eello5_4 C
7250 C Antiparallel chains C
7253 C /j\ / \ \ / \ / \ / C
7254 C / \ / \ \ / \ / \ / C
7255 C j1| o |l | o | o| o | | o |o C
7256 C \ |/k\| |/ \| / |/ \| |/ \| C
7257 C \i/ \ / \ / / \ / \ C
7259 C (I) (II) (III) (IV) C
7261 C eello5_1 eello5_2 eello5_3 eello5_4 C
7263 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7265 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7266 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7271 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7273 itk=itype2loc(itype(k))
7274 itl=itype2loc(itype(l))
7275 itj=itype2loc(itype(j))
7280 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7281 cd & eel5_3_num,eel5_4_num)
7285 derx(lll,kkk,iii)=0.0d0
7289 cd eij=facont_hb(jj,i)
7290 cd ekl=facont_hb(kk,k)
7292 cd write (iout,*)'Contacts have occurred for peptide groups',
7293 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7295 C Contribution from the graph I.
7296 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7297 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7298 call transpose2(EUg(1,1,k),auxmat(1,1))
7299 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7300 vv(1)=pizda(1,1)-pizda(2,2)
7301 vv(2)=pizda(1,2)+pizda(2,1)
7302 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7303 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7305 C Explicit gradient in virtual-dihedral angles.
7306 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7307 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7308 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7309 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7310 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7311 vv(1)=pizda(1,1)-pizda(2,2)
7312 vv(2)=pizda(1,2)+pizda(2,1)
7313 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7314 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7315 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7316 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7317 vv(1)=pizda(1,1)-pizda(2,2)
7318 vv(2)=pizda(1,2)+pizda(2,1)
7320 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7321 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7322 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7324 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7325 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7326 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7328 C Cartesian gradient
7332 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7334 vv(1)=pizda(1,1)-pizda(2,2)
7335 vv(2)=pizda(1,2)+pizda(2,1)
7336 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7337 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7338 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7345 C Contribution from graph II
7346 call transpose2(EE(1,1,k),auxmat(1,1))
7347 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7348 vv(1)=pizda(1,1)+pizda(2,2)
7349 vv(2)=pizda(2,1)-pizda(1,2)
7350 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7351 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7353 C Explicit gradient in virtual-dihedral angles.
7354 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7355 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7356 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7357 vv(1)=pizda(1,1)+pizda(2,2)
7358 vv(2)=pizda(2,1)-pizda(1,2)
7360 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7361 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7362 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7364 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7365 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7366 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7368 C Cartesian gradient
7372 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7374 vv(1)=pizda(1,1)+pizda(2,2)
7375 vv(2)=pizda(2,1)-pizda(1,2)
7376 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7377 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7378 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7387 C Parallel orientation
7388 C Contribution from graph III
7389 call transpose2(EUg(1,1,l),auxmat(1,1))
7390 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7391 vv(1)=pizda(1,1)-pizda(2,2)
7392 vv(2)=pizda(1,2)+pizda(2,1)
7393 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7394 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7396 C Explicit gradient in virtual-dihedral angles.
7397 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7398 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7399 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7400 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7401 vv(1)=pizda(1,1)-pizda(2,2)
7402 vv(2)=pizda(1,2)+pizda(2,1)
7403 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7404 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7405 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7406 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7407 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7408 vv(1)=pizda(1,1)-pizda(2,2)
7409 vv(2)=pizda(1,2)+pizda(2,1)
7410 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7411 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7412 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7413 C Cartesian gradient
7417 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7419 vv(1)=pizda(1,1)-pizda(2,2)
7420 vv(2)=pizda(1,2)+pizda(2,1)
7421 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7422 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7423 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7428 C Contribution from graph IV
7430 call transpose2(EE(1,1,l),auxmat(1,1))
7431 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7432 vv(1)=pizda(1,1)+pizda(2,2)
7433 vv(2)=pizda(2,1)-pizda(1,2)
7434 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7435 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7436 C Explicit gradient in virtual-dihedral angles.
7437 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7438 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7439 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7440 vv(1)=pizda(1,1)+pizda(2,2)
7441 vv(2)=pizda(2,1)-pizda(1,2)
7442 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7443 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7444 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7445 C Cartesian gradient
7449 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7451 vv(1)=pizda(1,1)+pizda(2,2)
7452 vv(2)=pizda(2,1)-pizda(1,2)
7453 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7454 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7455 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7461 C Antiparallel orientation
7462 C Contribution from graph III
7464 call transpose2(EUg(1,1,j),auxmat(1,1))
7465 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7466 vv(1)=pizda(1,1)-pizda(2,2)
7467 vv(2)=pizda(1,2)+pizda(2,1)
7468 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7469 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7471 C Explicit gradient in virtual-dihedral angles.
7472 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7473 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7474 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7475 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7476 vv(1)=pizda(1,1)-pizda(2,2)
7477 vv(2)=pizda(1,2)+pizda(2,1)
7478 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7479 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7480 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7481 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7482 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7483 vv(1)=pizda(1,1)-pizda(2,2)
7484 vv(2)=pizda(1,2)+pizda(2,1)
7485 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7486 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7487 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7488 C Cartesian gradient
7492 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7494 vv(1)=pizda(1,1)-pizda(2,2)
7495 vv(2)=pizda(1,2)+pizda(2,1)
7496 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7497 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7498 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7504 C Contribution from graph IV
7506 call transpose2(EE(1,1,j),auxmat(1,1))
7507 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7508 vv(1)=pizda(1,1)+pizda(2,2)
7509 vv(2)=pizda(2,1)-pizda(1,2)
7510 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7511 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7513 C Explicit gradient in virtual-dihedral angles.
7514 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7515 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7516 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7517 vv(1)=pizda(1,1)+pizda(2,2)
7518 vv(2)=pizda(2,1)-pizda(1,2)
7519 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7520 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7521 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7522 C Cartesian gradient
7526 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7528 vv(1)=pizda(1,1)+pizda(2,2)
7529 vv(2)=pizda(2,1)-pizda(1,2)
7530 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7531 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7532 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7539 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7540 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7541 cd write (2,*) 'ijkl',i,j,k,l
7542 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7543 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7545 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7546 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7547 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7548 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7550 if (j.lt.nres-1) then
7557 if (l.lt.nres-1) then
7567 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7568 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7569 C summed up outside the subrouine as for the other subroutines
7570 C handling long-range interactions. The old code is commented out
7571 C with "cgrad" to keep track of changes.
7573 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7574 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7575 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7576 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7577 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7578 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7579 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7580 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7581 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7582 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7584 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7585 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7586 cgrad ghalf=0.5d0*ggg1(ll)
7588 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7589 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7590 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7591 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7592 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7593 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7594 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7595 cgrad ghalf=0.5d0*ggg2(ll)
7597 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7598 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7599 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7600 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7601 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7602 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7608 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7609 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7614 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7615 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7621 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7626 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7630 cd write (2,*) iii,g_corr5_loc(iii)
7633 cd write (2,*) 'ekont',ekont
7634 cd write (iout,*) 'eello5',ekont*eel5
7637 c--------------------------------------------------------------------------
7638 double precision function eello6(i,j,k,l,jj,kk)
7639 implicit real*8 (a-h,o-z)
7640 include 'DIMENSIONS'
7641 include 'DIMENSIONS.ZSCOPT'
7642 include 'COMMON.IOUNITS'
7643 include 'COMMON.CHAIN'
7644 include 'COMMON.DERIV'
7645 include 'COMMON.INTERACT'
7646 include 'COMMON.CONTACTS'
7647 include 'COMMON.TORSION'
7648 include 'COMMON.VAR'
7649 include 'COMMON.GEO'
7650 include 'COMMON.FFIELD'
7651 double precision ggg1(3),ggg2(3)
7652 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7657 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7665 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7666 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7670 derx(lll,kkk,iii)=0.0d0
7674 cd eij=facont_hb(jj,i)
7675 cd ekl=facont_hb(kk,k)
7681 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7682 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7683 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7684 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7685 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7686 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7688 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7689 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7690 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7691 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7692 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7693 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7697 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7699 C If turn contributions are considered, they will be handled separately.
7700 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7701 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7702 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7703 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7704 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7705 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7706 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7709 if (j.lt.nres-1) then
7716 if (l.lt.nres-1) then
7724 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7725 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7726 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7727 cgrad ghalf=0.5d0*ggg1(ll)
7729 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7730 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7731 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7732 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7733 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7734 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7735 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7736 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7737 cgrad ghalf=0.5d0*ggg2(ll)
7738 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7740 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7741 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7742 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7743 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7744 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7745 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7751 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7752 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7757 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7758 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7764 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7769 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7773 cd write (2,*) iii,g_corr6_loc(iii)
7776 cd write (2,*) 'ekont',ekont
7777 cd write (iout,*) 'eello6',ekont*eel6
7780 c--------------------------------------------------------------------------
7781 double precision function eello6_graph1(i,j,k,l,imat,swap)
7782 implicit real*8 (a-h,o-z)
7783 include 'DIMENSIONS'
7784 include 'DIMENSIONS.ZSCOPT'
7785 include 'COMMON.IOUNITS'
7786 include 'COMMON.CHAIN'
7787 include 'COMMON.DERIV'
7788 include 'COMMON.INTERACT'
7789 include 'COMMON.CONTACTS'
7790 include 'COMMON.TORSION'
7791 include 'COMMON.VAR'
7792 include 'COMMON.GEO'
7793 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7797 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7799 C Parallel Antiparallel C
7805 C \ j|/k\| / \ |/k\|l / C
7810 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7811 itk=itype2loc(itype(k))
7812 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7813 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7814 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7815 call transpose2(EUgC(1,1,k),auxmat(1,1))
7816 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7817 vv1(1)=pizda1(1,1)-pizda1(2,2)
7818 vv1(2)=pizda1(1,2)+pizda1(2,1)
7819 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7820 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
7821 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
7822 s5=scalar2(vv(1),Dtobr2(1,i))
7823 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7824 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7826 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7827 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7828 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7829 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7830 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7831 & +scalar2(vv(1),Dtobr2der(1,i)))
7832 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7833 vv1(1)=pizda1(1,1)-pizda1(2,2)
7834 vv1(2)=pizda1(1,2)+pizda1(2,1)
7835 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
7836 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
7838 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7839 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7840 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7841 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7842 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7844 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7845 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7846 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7847 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7848 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7850 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7851 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7852 vv1(1)=pizda1(1,1)-pizda1(2,2)
7853 vv1(2)=pizda1(1,2)+pizda1(2,1)
7854 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7855 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7856 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7857 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7866 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7867 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7868 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7869 call transpose2(EUgC(1,1,k),auxmat(1,1))
7870 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7872 vv1(1)=pizda1(1,1)-pizda1(2,2)
7873 vv1(2)=pizda1(1,2)+pizda1(2,1)
7874 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7875 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
7876 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
7877 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
7878 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
7879 s5=scalar2(vv(1),Dtobr2(1,i))
7880 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7887 c----------------------------------------------------------------------------
7888 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7889 implicit real*8 (a-h,o-z)
7890 include 'DIMENSIONS'
7891 include 'DIMENSIONS.ZSCOPT'
7892 include 'COMMON.IOUNITS'
7893 include 'COMMON.CHAIN'
7894 include 'COMMON.DERIV'
7895 include 'COMMON.INTERACT'
7896 include 'COMMON.CONTACTS'
7897 include 'COMMON.TORSION'
7898 include 'COMMON.VAR'
7899 include 'COMMON.GEO'
7901 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7902 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7905 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7907 C Parallel Antiparallel C
7913 C \ j|/k\| \ |/k\|l C
7918 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7919 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7920 C AL 7/4/01 s1 would occur in the sixth-order moment,
7921 C but not in a cluster cumulant
7923 s1=dip(1,jj,i)*dip(1,kk,k)
7925 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7926 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7927 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7928 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7929 call transpose2(EUg(1,1,k),auxmat(1,1))
7930 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7931 vv(1)=pizda(1,1)-pizda(2,2)
7932 vv(2)=pizda(1,2)+pizda(2,1)
7933 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7934 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7936 eello6_graph2=-(s1+s2+s3+s4)
7938 eello6_graph2=-(s2+s3+s4)
7941 C Derivatives in gamma(i-1)
7945 s1=dipderg(1,jj,i)*dip(1,kk,k)
7947 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7948 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7949 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7950 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7952 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7954 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7956 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7958 C Derivatives in gamma(k-1)
7960 s1=dip(1,jj,i)*dipderg(1,kk,k)
7962 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7963 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7964 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7965 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7966 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7967 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7968 vv(1)=pizda(1,1)-pizda(2,2)
7969 vv(2)=pizda(1,2)+pizda(2,1)
7970 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7972 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7974 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7976 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7977 C Derivatives in gamma(j-1) or gamma(l-1)
7980 s1=dipderg(3,jj,i)*dip(1,kk,k)
7982 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7983 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7984 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7985 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7986 vv(1)=pizda(1,1)-pizda(2,2)
7987 vv(2)=pizda(1,2)+pizda(2,1)
7988 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7991 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7993 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7996 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7997 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7999 C Derivatives in gamma(l-1) or gamma(j-1)
8002 s1=dip(1,jj,i)*dipderg(3,kk,k)
8004 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8005 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8006 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8007 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8008 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8009 vv(1)=pizda(1,1)-pizda(2,2)
8010 vv(2)=pizda(1,2)+pizda(2,1)
8011 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8014 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8016 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8019 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8020 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8022 C Cartesian derivatives.
8024 write (2,*) 'In eello6_graph2'
8026 write (2,*) 'iii=',iii
8028 write (2,*) 'kkk=',kkk
8030 write (2,'(3(2f10.5),5x)')
8031 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8041 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8043 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8046 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8048 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8049 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8051 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8052 call transpose2(EUg(1,1,k),auxmat(1,1))
8053 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8055 vv(1)=pizda(1,1)-pizda(2,2)
8056 vv(2)=pizda(1,2)+pizda(2,1)
8057 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8058 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8060 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8062 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8065 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8067 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8075 c----------------------------------------------------------------------------
8076 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8077 implicit real*8 (a-h,o-z)
8078 include 'DIMENSIONS'
8079 include 'DIMENSIONS.ZSCOPT'
8080 include 'COMMON.IOUNITS'
8081 include 'COMMON.CHAIN'
8082 include 'COMMON.DERIV'
8083 include 'COMMON.INTERACT'
8084 include 'COMMON.CONTACTS'
8085 include 'COMMON.TORSION'
8086 include 'COMMON.VAR'
8087 include 'COMMON.GEO'
8088 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8090 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8092 C Parallel Antiparallel C
8098 C j|/k\| / |/k\|l / C
8103 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8105 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8106 C energy moment and not to the cluster cumulant.
8107 iti=itortyp(itype(i))
8108 if (j.lt.nres-1) then
8109 itj1=itype2loc(itype(j+1))
8113 itk=itype2loc(itype(k))
8114 itk1=itype2loc(itype(k+1))
8115 if (l.lt.nres-1) then
8116 itl1=itype2loc(itype(l+1))
8121 s1=dip(4,jj,i)*dip(4,kk,k)
8123 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8124 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8125 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8126 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8127 call transpose2(EE(1,1,k),auxmat(1,1))
8128 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8129 vv(1)=pizda(1,1)+pizda(2,2)
8130 vv(2)=pizda(2,1)-pizda(1,2)
8131 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8132 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8133 cd & "sum",-(s2+s3+s4)
8135 eello6_graph3=-(s1+s2+s3+s4)
8137 eello6_graph3=-(s2+s3+s4)
8140 C Derivatives in gamma(k-1)
8142 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8143 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8144 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8145 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8146 C Derivatives in gamma(l-1)
8147 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8148 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8149 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8150 vv(1)=pizda(1,1)+pizda(2,2)
8151 vv(2)=pizda(2,1)-pizda(1,2)
8152 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8153 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8154 C Cartesian derivatives.
8160 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8162 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8165 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8167 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8168 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8170 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8171 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8173 vv(1)=pizda(1,1)+pizda(2,2)
8174 vv(2)=pizda(2,1)-pizda(1,2)
8175 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8177 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8179 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8182 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8184 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8186 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8193 c----------------------------------------------------------------------------
8194 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8195 implicit real*8 (a-h,o-z)
8196 include 'DIMENSIONS'
8197 include 'DIMENSIONS.ZSCOPT'
8198 include 'COMMON.IOUNITS'
8199 include 'COMMON.CHAIN'
8200 include 'COMMON.DERIV'
8201 include 'COMMON.INTERACT'
8202 include 'COMMON.CONTACTS'
8203 include 'COMMON.TORSION'
8204 include 'COMMON.VAR'
8205 include 'COMMON.GEO'
8206 include 'COMMON.FFIELD'
8207 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8208 & auxvec1(2),auxmat1(2,2)
8210 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8212 C Parallel Antiparallel C
8218 C \ j|/k\| \ |/k\|l C
8223 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8225 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8226 C energy moment and not to the cluster cumulant.
8227 cd write (2,*) 'eello_graph4: wturn6',wturn6
8228 iti=itype2loc(itype(i))
8229 itj=itype2loc(itype(j))
8230 if (j.lt.nres-1) then
8231 itj1=itype2loc(itype(j+1))
8235 itk=itype2loc(itype(k))
8236 if (k.lt.nres-1) then
8237 itk1=itype2loc(itype(k+1))
8241 itl=itype2loc(itype(l))
8242 if (l.lt.nres-1) then
8243 itl1=itype2loc(itype(l+1))
8247 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8248 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8249 cd & ' itl',itl,' itl1',itl1
8252 s1=dip(3,jj,i)*dip(3,kk,k)
8254 s1=dip(2,jj,j)*dip(2,kk,l)
8257 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8258 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8260 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8261 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8263 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8264 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8266 call transpose2(EUg(1,1,k),auxmat(1,1))
8267 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8268 vv(1)=pizda(1,1)-pizda(2,2)
8269 vv(2)=pizda(2,1)+pizda(1,2)
8270 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8271 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8273 eello6_graph4=-(s1+s2+s3+s4)
8275 eello6_graph4=-(s2+s3+s4)
8277 C Derivatives in gamma(i-1)
8282 s1=dipderg(2,jj,i)*dip(3,kk,k)
8284 s1=dipderg(4,jj,j)*dip(2,kk,l)
8287 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8289 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8290 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8292 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8293 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8295 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8296 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8297 cd write (2,*) 'turn6 derivatives'
8299 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8301 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8305 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8307 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8311 C Derivatives in gamma(k-1)
8314 s1=dip(3,jj,i)*dipderg(2,kk,k)
8316 s1=dip(2,jj,j)*dipderg(4,kk,l)
8319 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8320 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8322 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8323 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8325 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8326 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8328 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8329 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8330 vv(1)=pizda(1,1)-pizda(2,2)
8331 vv(2)=pizda(2,1)+pizda(1,2)
8332 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8333 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8335 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8337 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8341 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8343 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8346 C Derivatives in gamma(j-1) or gamma(l-1)
8347 if (l.eq.j+1 .and. l.gt.1) then
8348 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8349 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8350 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8351 vv(1)=pizda(1,1)-pizda(2,2)
8352 vv(2)=pizda(2,1)+pizda(1,2)
8353 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8354 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8355 else if (j.gt.1) then
8356 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8357 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8358 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8359 vv(1)=pizda(1,1)-pizda(2,2)
8360 vv(2)=pizda(2,1)+pizda(1,2)
8361 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8362 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8363 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8365 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8368 C Cartesian derivatives.
8375 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8377 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8381 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8383 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8387 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8389 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8391 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8392 & b1(1,j+1),auxvec(1))
8393 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8395 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8396 & b1(1,l+1),auxvec(1))
8397 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8399 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8401 vv(1)=pizda(1,1)-pizda(2,2)
8402 vv(2)=pizda(2,1)+pizda(1,2)
8403 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8405 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8407 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8410 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8413 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8416 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8418 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8420 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8424 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8426 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8429 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8431 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8440 c----------------------------------------------------------------------------
8441 double precision function eello_turn6(i,jj,kk)
8442 implicit real*8 (a-h,o-z)
8443 include 'DIMENSIONS'
8444 include 'DIMENSIONS.ZSCOPT'
8445 include 'COMMON.IOUNITS'
8446 include 'COMMON.CHAIN'
8447 include 'COMMON.DERIV'
8448 include 'COMMON.INTERACT'
8449 include 'COMMON.CONTACTS'
8450 include 'COMMON.TORSION'
8451 include 'COMMON.VAR'
8452 include 'COMMON.GEO'
8453 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8454 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8456 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8457 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8458 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8459 C the respective energy moment and not to the cluster cumulant.
8468 iti=itype2loc(itype(i))
8469 itk=itype2loc(itype(k))
8470 itk1=itype2loc(itype(k+1))
8471 itl=itype2loc(itype(l))
8472 itj=itype2loc(itype(j))
8473 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8474 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8475 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8480 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8482 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8486 derx_turn(lll,kkk,iii)=0.0d0
8493 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8495 cd write (2,*) 'eello6_5',eello6_5
8497 call transpose2(AEA(1,1,1),auxmat(1,1))
8498 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8499 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8500 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8502 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8503 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8504 s2 = scalar2(b1(1,k),vtemp1(1))
8506 call transpose2(AEA(1,1,2),atemp(1,1))
8507 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8508 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8509 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8511 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8512 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8513 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8515 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8516 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8517 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8518 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8519 ss13 = scalar2(b1(1,k),vtemp4(1))
8520 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8522 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8528 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8529 C Derivatives in gamma(i+2)
8534 call transpose2(AEA(1,1,1),auxmatd(1,1))
8535 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8536 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8537 call transpose2(AEAderg(1,1,2),atempd(1,1))
8538 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8539 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8541 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8542 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8543 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8549 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8550 C Derivatives in gamma(i+3)
8552 call transpose2(AEA(1,1,1),auxmatd(1,1))
8553 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8554 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8555 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8557 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8558 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8559 s2d = scalar2(b1(1,k),vtemp1d(1))
8561 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8562 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8564 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8566 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8567 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8568 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8576 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8577 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8579 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8580 & -0.5d0*ekont*(s2d+s12d)
8582 C Derivatives in gamma(i+4)
8583 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8584 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8585 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8587 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8588 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8589 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8597 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8599 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8601 C Derivatives in gamma(i+5)
8603 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8604 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8605 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8607 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8608 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8609 s2d = scalar2(b1(1,k),vtemp1d(1))
8611 call transpose2(AEA(1,1,2),atempd(1,1))
8612 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8613 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8615 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8616 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8618 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8619 ss13d = scalar2(b1(1,k),vtemp4d(1))
8620 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8628 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8629 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8631 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8632 & -0.5d0*ekont*(s2d+s12d)
8634 C Cartesian derivatives
8639 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8640 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8641 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8643 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8644 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8646 s2d = scalar2(b1(1,k),vtemp1d(1))
8648 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8649 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8650 s8d = -(atempd(1,1)+atempd(2,2))*
8651 & scalar2(cc(1,1,l),vtemp2(1))
8653 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8655 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8656 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8663 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8666 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8670 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8671 & - 0.5d0*(s8d+s12d)
8673 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8682 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8684 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8685 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8686 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8687 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8688 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8690 ss13d = scalar2(b1(1,k),vtemp4d(1))
8691 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8692 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8696 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8697 cd & 16*eel_turn6_num
8699 if (j.lt.nres-1) then
8706 if (l.lt.nres-1) then
8714 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8715 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8716 cgrad ghalf=0.5d0*ggg1(ll)
8718 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8719 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8720 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8721 & +ekont*derx_turn(ll,2,1)
8722 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8723 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8724 & +ekont*derx_turn(ll,4,1)
8725 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8726 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8727 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8728 cgrad ghalf=0.5d0*ggg2(ll)
8730 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8731 & +ekont*derx_turn(ll,2,2)
8732 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8733 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8734 & +ekont*derx_turn(ll,4,2)
8735 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8736 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8737 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8742 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8747 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8753 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8758 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8762 cd write (2,*) iii,g_corr6_loc(iii)
8765 eello_turn6=ekont*eel_turn6
8766 cd write (2,*) 'ekont',ekont
8767 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8771 crc-------------------------------------------------
8772 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8773 subroutine Eliptransfer(eliptran)
8774 implicit real*8 (a-h,o-z)
8775 include 'DIMENSIONS'
8776 include 'DIMENSIONS.ZSCOPT'
8777 include 'COMMON.GEO'
8778 include 'COMMON.VAR'
8779 include 'COMMON.LOCAL'
8780 include 'COMMON.CHAIN'
8781 include 'COMMON.DERIV'
8782 include 'COMMON.INTERACT'
8783 include 'COMMON.IOUNITS'
8784 include 'COMMON.CALC'
8785 include 'COMMON.CONTROL'
8786 include 'COMMON.SPLITELE'
8787 include 'COMMON.SBRIDGE'
8788 C this is done by Adasko
8792 C--bordliptop-- buffore starts
8793 C--bufliptop--- here true lipid starts
8795 C--buflipbot--- lipid ends buffore starts
8796 C--bordlipbot--buffore ends
8800 if (itype(i).eq.ntyp1) cycle
8802 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8803 if (positi.le.0) positi=positi+boxzsize
8805 C first for peptide groups
8806 c for each residue check if it is in lipid or lipid water border area
8807 if ((positi.gt.bordlipbot)
8808 &.and.(positi.lt.bordliptop)) then
8809 C the energy transfer exist
8810 if (positi.lt.buflipbot) then
8811 C what fraction I am in
8813 & ((positi-bordlipbot)/lipbufthick)
8814 C lipbufthick is thickenes of lipid buffore
8815 sslip=sscalelip(fracinbuf)
8816 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8817 eliptran=eliptran+sslip*pepliptran
8818 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8819 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8820 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8821 elseif (positi.gt.bufliptop) then
8822 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8823 sslip=sscalelip(fracinbuf)
8824 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8825 eliptran=eliptran+sslip*pepliptran
8826 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8827 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8828 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8829 C print *, "doing sscalefor top part"
8830 C print *,i,sslip,fracinbuf,ssgradlip
8832 eliptran=eliptran+pepliptran
8833 C print *,"I am in true lipid"
8836 C eliptran=elpitran+0.0 ! I am in water
8839 C print *, "nic nie bylo w lipidzie?"
8840 C now multiply all by the peptide group transfer factor
8841 C eliptran=eliptran*pepliptran
8842 C now the same for side chains
8845 if (itype(i).eq.ntyp1) cycle
8846 positi=(mod(c(3,i+nres),boxzsize))
8847 if (positi.le.0) positi=positi+boxzsize
8848 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8849 c for each residue check if it is in lipid or lipid water border area
8850 C respos=mod(c(3,i+nres),boxzsize)
8851 C print *,positi,bordlipbot,buflipbot
8852 if ((positi.gt.bordlipbot)
8853 & .and.(positi.lt.bordliptop)) then
8854 C the energy transfer exist
8855 if (positi.lt.buflipbot) then
8857 & ((positi-bordlipbot)/lipbufthick)
8858 C lipbufthick is thickenes of lipid buffore
8859 sslip=sscalelip(fracinbuf)
8860 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8861 eliptran=eliptran+sslip*liptranene(itype(i))
8862 gliptranx(3,i)=gliptranx(3,i)
8863 &+ssgradlip*liptranene(itype(i))
8864 gliptranc(3,i-1)= gliptranc(3,i-1)
8865 &+ssgradlip*liptranene(itype(i))
8866 C print *,"doing sccale for lower part"
8867 elseif (positi.gt.bufliptop) then
8869 &((bordliptop-positi)/lipbufthick)
8870 sslip=sscalelip(fracinbuf)
8871 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8872 eliptran=eliptran+sslip*liptranene(itype(i))
8873 gliptranx(3,i)=gliptranx(3,i)
8874 &+ssgradlip*liptranene(itype(i))
8875 gliptranc(3,i-1)= gliptranc(3,i-1)
8876 &+ssgradlip*liptranene(itype(i))
8877 C print *, "doing sscalefor top part",sslip,fracinbuf
8879 eliptran=eliptran+liptranene(itype(i))
8880 C print *,"I am in true lipid"
8882 endif ! if in lipid or buffor
8884 C eliptran=elpitran+0.0 ! I am in water
8890 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8892 SUBROUTINE MATVEC2(A1,V1,V2)
8893 implicit real*8 (a-h,o-z)
8894 include 'DIMENSIONS'
8895 DIMENSION A1(2,2),V1(2),V2(2)
8899 c 3 VI=VI+A1(I,K)*V1(K)
8903 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8904 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8909 C---------------------------------------
8910 SUBROUTINE MATMAT2(A1,A2,A3)
8911 implicit real*8 (a-h,o-z)
8912 include 'DIMENSIONS'
8913 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8914 c DIMENSION AI3(2,2)
8918 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8924 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8925 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8926 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8927 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8935 c-------------------------------------------------------------------------
8936 double precision function scalar2(u,v)
8938 double precision u(2),v(2)
8941 scalar2=u(1)*v(1)+u(2)*v(2)
8945 C-----------------------------------------------------------------------------
8947 subroutine transpose2(a,at)
8949 double precision a(2,2),at(2,2)
8956 c--------------------------------------------------------------------------
8957 subroutine transpose(n,a,at)
8960 double precision a(n,n),at(n,n)
8968 C---------------------------------------------------------------------------
8969 subroutine prodmat3(a1,a2,kk,transp,prod)
8972 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8974 crc double precision auxmat(2,2),prod_(2,2)
8977 crc call transpose2(kk(1,1),auxmat(1,1))
8978 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8979 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8981 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8982 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8983 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8984 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8985 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8986 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8987 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8988 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8991 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8992 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8994 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8995 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8996 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8997 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8998 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8999 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9000 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9001 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9004 c call transpose2(a2(1,1),a2t(1,1))
9007 crc print *,((prod_(i,j),i=1,2),j=1,2)
9008 crc print *,((prod(i,j),i=1,2),j=1,2)
9012 C-----------------------------------------------------------------------------
9013 double precision function scalar(u,v)
9015 double precision u(3),v(3)
9025 C-----------------------------------------------------------------------
9026 double precision function sscale(r)
9027 double precision r,gamm
9028 include "COMMON.SPLITELE"
9029 if(r.lt.r_cut-rlamb) then
9031 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9032 gamm=(r-(r_cut-rlamb))/rlamb
9033 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9039 C-----------------------------------------------------------------------
9040 C-----------------------------------------------------------------------
9041 double precision function sscagrad(r)
9042 double precision r,gamm
9043 include "COMMON.SPLITELE"
9044 if(r.lt.r_cut-rlamb) then
9046 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9047 gamm=(r-(r_cut-rlamb))/rlamb
9048 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9054 C-----------------------------------------------------------------------
9055 C-----------------------------------------------------------------------
9056 double precision function sscalelip(r)
9057 double precision r,gamm
9058 include "COMMON.SPLITELE"
9059 C if(r.lt.r_cut-rlamb) then
9061 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9062 C gamm=(r-(r_cut-rlamb))/rlamb
9063 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9069 C-----------------------------------------------------------------------
9070 double precision function sscagradlip(r)
9071 double precision r,gamm
9072 include "COMMON.SPLITELE"
9073 C if(r.lt.r_cut-rlamb) then
9075 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9076 C gamm=(r-(r_cut-rlamb))/rlamb
9077 sscagradlip=r*(6*r-6.0d0)
9084 C-----------------------------------------------------------------------
9085 subroutine set_shield_fac
9086 implicit real*8 (a-h,o-z)
9087 include 'DIMENSIONS'
9088 include 'DIMENSIONS.ZSCOPT'
9089 include 'COMMON.CHAIN'
9090 include 'COMMON.DERIV'
9091 include 'COMMON.IOUNITS'
9092 include 'COMMON.SHIELD'
9093 include 'COMMON.INTERACT'
9094 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9095 double precision div77_81/0.974996043d0/,
9096 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9098 C the vector between center of side_chain and peptide group
9099 double precision pep_side(3),long,side_calf(3),
9100 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9101 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9102 C the line belowe needs to be changed for FGPROC>1
9104 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9106 Cif there two consequtive dummy atoms there is no peptide group between them
9107 C the line below has to be changed for FGPROC>1
9110 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9114 C first lets set vector conecting the ithe side-chain with kth side-chain
9115 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9117 C and vector conecting the side-chain with its proper calfa
9118 side_calf(j)=c(j,k+nres)-c(j,k)
9119 C side_calf(j)=2.0d0
9120 pept_group(j)=c(j,i)-c(j,i+1)
9121 C lets have their lenght
9122 dist_pep_side=pep_side(j)**2+dist_pep_side
9123 dist_side_calf=dist_side_calf+side_calf(j)**2
9124 dist_pept_group=dist_pept_group+pept_group(j)**2
9126 dist_pep_side=dsqrt(dist_pep_side)
9127 dist_pept_group=dsqrt(dist_pept_group)
9128 dist_side_calf=dsqrt(dist_side_calf)
9130 pep_side_norm(j)=pep_side(j)/dist_pep_side
9131 side_calf_norm(j)=dist_side_calf
9133 C now sscale fraction
9134 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9135 C print *,buff_shield,"buff"
9137 if (sh_frac_dist.le.0.0) cycle
9138 C If we reach here it means that this side chain reaches the shielding sphere
9139 C Lets add him to the list for gradient
9140 ishield_list(i)=ishield_list(i)+1
9141 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9142 C this list is essential otherwise problem would be O3
9143 shield_list(ishield_list(i),i)=k
9144 C Lets have the sscale value
9145 if (sh_frac_dist.gt.1.0) then
9146 scale_fac_dist=1.0d0
9148 sh_frac_dist_grad(j)=0.0d0
9151 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9152 & *(2.0*sh_frac_dist-3.0d0)
9153 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9154 & /dist_pep_side/buff_shield*0.5
9155 C remember for the final gradient multiply sh_frac_dist_grad(j)
9156 C for side_chain by factor -2 !
9158 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9159 C print *,"jestem",scale_fac_dist,fac_help_scale,
9160 C & sh_frac_dist_grad(j)
9163 C if ((i.eq.3).and.(k.eq.2)) then
9164 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9168 C this is what is now we have the distance scaling now volume...
9169 short=short_r_sidechain(itype(k))
9170 long=long_r_sidechain(itype(k))
9171 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9174 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9177 costhet_grad(j)=costhet_fac*pep_side(j)
9179 C remember for the final gradient multiply costhet_grad(j)
9180 C for side_chain by factor -2 !
9181 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9182 C pep_side0pept_group is vector multiplication
9183 pep_side0pept_group=0.0
9185 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9187 cosalfa=(pep_side0pept_group/
9188 & (dist_pep_side*dist_side_calf))
9189 fac_alfa_sin=1.0-cosalfa**2
9190 fac_alfa_sin=dsqrt(fac_alfa_sin)
9191 rkprim=fac_alfa_sin*(long-short)+short
9193 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9194 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9197 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9198 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9199 &*(long-short)/fac_alfa_sin*cosalfa/
9200 &((dist_pep_side*dist_side_calf))*
9201 &((side_calf(j))-cosalfa*
9202 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9204 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9205 &*(long-short)/fac_alfa_sin*cosalfa
9206 &/((dist_pep_side*dist_side_calf))*
9208 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9211 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9214 C now the gradient...
9215 C grad_shield is gradient of Calfa for peptide groups
9216 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9218 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9219 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9221 grad_shield(j,i)=grad_shield(j,i)
9222 C gradient po skalowaniu
9223 & +(sh_frac_dist_grad(j)
9224 C gradient po costhet
9225 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9226 &-scale_fac_dist*(cosphi_grad_long(j))
9227 &/(1.0-cosphi) )*div77_81
9229 C grad_shield_side is Cbeta sidechain gradient
9230 grad_shield_side(j,ishield_list(i),i)=
9231 & (sh_frac_dist_grad(j)*(-2.0d0)
9232 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9233 & +scale_fac_dist*(cosphi_grad_long(j))
9234 & *2.0d0/(1.0-cosphi))
9235 & *div77_81*VofOverlap
9237 grad_shield_loc(j,ishield_list(i),i)=
9238 & scale_fac_dist*cosphi_grad_loc(j)
9239 & *2.0d0/(1.0-cosphi)
9240 & *div77_81*VofOverlap
9242 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9244 fac_shield(i)=VolumeTotal*div77_81+div4_81
9245 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9249 C--------------------------------------------------------------------------
9250 C first for shielding is setting of function of side-chains
9251 subroutine set_shield_fac2
9252 implicit real*8 (a-h,o-z)
9253 include 'DIMENSIONS'
9254 include 'DIMENSIONS.ZSCOPT'
9255 include 'COMMON.CHAIN'
9256 include 'COMMON.DERIV'
9257 include 'COMMON.IOUNITS'
9258 include 'COMMON.SHIELD'
9259 include 'COMMON.INTERACT'
9260 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9261 double precision div77_81/0.974996043d0/,
9262 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9264 C the vector between center of side_chain and peptide group
9265 double precision pep_side(3),long,side_calf(3),
9266 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9267 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9268 C the line belowe needs to be changed for FGPROC>1
9270 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9272 Cif there two consequtive dummy atoms there is no peptide group between them
9273 C the line below has to be changed for FGPROC>1
9276 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9280 C first lets set vector conecting the ithe side-chain with kth side-chain
9281 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9283 C and vector conecting the side-chain with its proper calfa
9284 side_calf(j)=c(j,k+nres)-c(j,k)
9285 C side_calf(j)=2.0d0
9286 pept_group(j)=c(j,i)-c(j,i+1)
9287 C lets have their lenght
9288 dist_pep_side=pep_side(j)**2+dist_pep_side
9289 dist_side_calf=dist_side_calf+side_calf(j)**2
9290 dist_pept_group=dist_pept_group+pept_group(j)**2
9292 dist_pep_side=dsqrt(dist_pep_side)
9293 dist_pept_group=dsqrt(dist_pept_group)
9294 dist_side_calf=dsqrt(dist_side_calf)
9296 pep_side_norm(j)=pep_side(j)/dist_pep_side
9297 side_calf_norm(j)=dist_side_calf
9299 C now sscale fraction
9300 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9301 C print *,buff_shield,"buff"
9303 if (sh_frac_dist.le.0.0) cycle
9304 C If we reach here it means that this side chain reaches the shielding sphere
9305 C Lets add him to the list for gradient
9306 ishield_list(i)=ishield_list(i)+1
9307 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9308 C this list is essential otherwise problem would be O3
9309 shield_list(ishield_list(i),i)=k
9310 C Lets have the sscale value
9311 if (sh_frac_dist.gt.1.0) then
9312 scale_fac_dist=1.0d0
9314 sh_frac_dist_grad(j)=0.0d0
9317 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9318 & *(2.0d0*sh_frac_dist-3.0d0)
9319 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9320 & /dist_pep_side/buff_shield*0.5d0
9321 C remember for the final gradient multiply sh_frac_dist_grad(j)
9322 C for side_chain by factor -2 !
9324 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9325 C sh_frac_dist_grad(j)=0.0d0
9326 C scale_fac_dist=1.0d0
9327 C print *,"jestem",scale_fac_dist,fac_help_scale,
9328 C & sh_frac_dist_grad(j)
9331 C this is what is now we have the distance scaling now volume...
9332 short=short_r_sidechain(itype(k))
9333 long=long_r_sidechain(itype(k))
9334 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9335 sinthet=short/dist_pep_side*costhet
9339 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9340 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9341 C & -short/dist_pep_side**2/costhet)
9344 costhet_grad(j)=costhet_fac*pep_side(j)
9346 C remember for the final gradient multiply costhet_grad(j)
9347 C for side_chain by factor -2 !
9348 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9349 C pep_side0pept_group is vector multiplication
9350 pep_side0pept_group=0.0d0
9352 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9354 cosalfa=(pep_side0pept_group/
9355 & (dist_pep_side*dist_side_calf))
9356 fac_alfa_sin=1.0d0-cosalfa**2
9357 fac_alfa_sin=dsqrt(fac_alfa_sin)
9358 rkprim=fac_alfa_sin*(long-short)+short
9362 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9364 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9365 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9369 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9370 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9371 &*(long-short)/fac_alfa_sin*cosalfa/
9372 &((dist_pep_side*dist_side_calf))*
9373 &((side_calf(j))-cosalfa*
9374 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9375 C cosphi_grad_long(j)=0.0d0
9376 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9377 &*(long-short)/fac_alfa_sin*cosalfa
9378 &/((dist_pep_side*dist_side_calf))*
9380 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9381 C cosphi_grad_loc(j)=0.0d0
9383 C print *,sinphi,sinthet
9384 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9387 C now the gradient...
9389 grad_shield(j,i)=grad_shield(j,i)
9390 C gradient po skalowaniu
9391 & +(sh_frac_dist_grad(j)*VofOverlap
9392 C gradient po costhet
9393 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9394 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9395 & sinphi/sinthet*costhet*costhet_grad(j)
9396 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9398 C grad_shield_side is Cbeta sidechain gradient
9399 grad_shield_side(j,ishield_list(i),i)=
9400 & (sh_frac_dist_grad(j)*(-2.0d0)
9402 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9403 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9404 & sinphi/sinthet*costhet*costhet_grad(j)
9405 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9408 grad_shield_loc(j,ishield_list(i),i)=
9409 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9410 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9411 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9415 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9417 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9418 c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i),
9419 c & " wshield",wshield
9420 c write(2,*) "TU",rpp(1,1),short,long,buff_shield
9424 C--------------------------------------------------------------------------
9425 double precision function tschebyshev(m,n,x,y)
9427 include "DIMENSIONS"
9429 double precision x(n),y,yy(0:maxvar),aux
9430 c Tschebyshev polynomial. Note that the first term is omitted
9431 c m=0: the constant term is included
9432 c m=1: the constant term is not included
9436 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9445 C--------------------------------------------------------------------------
9446 double precision function gradtschebyshev(m,n,x,y)
9448 include "DIMENSIONS"
9450 double precision x(n+1),y,yy(0:maxvar),aux
9451 c Tschebyshev polynomial. Note that the first term is omitted
9452 c m=0: the constant term is included
9453 c m=1: the constant term is not included
9457 yy(i)=2*y*yy(i-1)-yy(i-2)
9461 aux=aux+x(i+1)*yy(i)*(i+1)
9462 C print *, x(i+1),yy(i),i
9467 c----------------------------------------------------------------------------
9468 double precision function sscale2(r,r_cut,r0,rlamb)
9470 double precision r,gamm,r_cut,r0,rlamb,rr
9472 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9473 c write (2,*) "rr",rr
9474 if(rr.lt.r_cut-rlamb) then
9476 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9477 gamm=(rr-(r_cut-rlamb))/rlamb
9478 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9484 C-----------------------------------------------------------------------
9485 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9487 double precision r,gamm,r_cut,r0,rlamb,rr
9489 if(rr.lt.r_cut-rlamb) then
9491 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9492 gamm=(rr-(r_cut-rlamb))/rlamb
9494 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9496 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9503 c----------------------------------------------------------------------------
9504 subroutine e_saxs(Esaxs_constr)
9506 include 'DIMENSIONS'
9507 include 'DIMENSIONS.ZSCOPT'
9508 include 'DIMENSIONS.FREE'
9511 include "COMMON.SETUP"
9514 include 'COMMON.SBRIDGE'
9515 include 'COMMON.CHAIN'
9516 include 'COMMON.GEO'
9517 include 'COMMON.LOCAL'
9518 include 'COMMON.INTERACT'
9519 include 'COMMON.VAR'
9520 include 'COMMON.IOUNITS'
9521 include 'COMMON.DERIV'
9522 include 'COMMON.CONTROL'
9523 include 'COMMON.NAMES'
9524 include 'COMMON.FFIELD'
9525 include 'COMMON.LANGEVIN'
9527 double precision Esaxs_constr
9528 integer i,iint,j,k,l
9529 double precision PgradC(maxSAXS,3,maxres),
9530 & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS)
9532 double precision PgradC_(maxSAXS,3,maxres),
9533 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9535 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9536 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9537 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9538 & auxX,auxX1,CACAgrad,Cnorm
9539 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9540 double precision dist
9542 c SAXS restraint penalty function
9544 write(iout,*) "------- SAXS penalty function start -------"
9545 write (iout,*) "nsaxs",nsaxs
9546 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9547 write (iout,*) "Psaxs"
9549 write (iout,'(i5,e15.5)') i, Psaxs(i)
9552 Esaxs_constr = 0.0d0
9562 do i=iatsc_s,iatsc_e
9563 if (itype(i).eq.ntyp1) cycle
9564 do iint=1,nint_gr(i)
9565 do j=istart(i,iint),iend(i,iint)
9566 if (itype(j).eq.ntyp1) cycle
9569 dijCASC=dist(i,j+nres)
9570 dijSCCA=dist(i+nres,j)
9571 dijSCSC=dist(i+nres,j+nres)
9572 sigma2CACA=2.0d0/(pstok**2)
9573 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9574 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9575 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9578 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9579 if (itype(j).ne.10) then
9580 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9584 if (itype(i).ne.10) then
9585 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9589 if (itype(i).ne.10 .and. itype(j).ne.10) then
9590 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9594 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9596 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9598 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9599 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9600 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9601 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9604 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9605 PgradC(k,l,i) = PgradC(k,l,i)-aux
9606 PgradC(k,l,j) = PgradC(k,l,j)+aux
9608 if (itype(j).ne.10) then
9609 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9610 PgradC(k,l,i) = PgradC(k,l,i)-aux
9611 PgradC(k,l,j) = PgradC(k,l,j)+aux
9612 PgradX(k,l,j) = PgradX(k,l,j)+aux
9615 if (itype(i).ne.10) then
9616 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9617 PgradX(k,l,i) = PgradX(k,l,i)-aux
9618 PgradC(k,l,i) = PgradC(k,l,i)-aux
9619 PgradC(k,l,j) = PgradC(k,l,j)+aux
9622 if (itype(i).ne.10 .and. itype(j).ne.10) then
9623 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9624 PgradC(k,l,i) = PgradC(k,l,i)-aux
9625 PgradC(k,l,j) = PgradC(k,l,j)+aux
9626 PgradX(k,l,i) = PgradX(k,l,i)-aux
9627 PgradX(k,l,j) = PgradX(k,l,j)+aux
9633 sigma2CACA=scal_rad**2*0.25d0/
9634 & (restok(itype(j))**2+restok(itype(i))**2)
9636 IF (saxs_cutoff.eq.0) THEN
9639 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9640 Pcalc(k) = Pcalc(k)+expCACA
9641 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9643 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9644 PgradC(k,l,i) = PgradC(k,l,i)-aux
9645 PgradC(k,l,j) = PgradC(k,l,j)+aux
9649 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9652 c write (2,*) "ijk",i,j,k
9653 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9654 if (sss2.eq.0.0d0) cycle
9655 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9656 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9657 Pcalc(k) = Pcalc(k)+expCACA
9659 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9661 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9662 & ssgrad2*expCACA/sss2
9665 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9666 PgradC(k,l,i) = PgradC(k,l,i)+aux
9667 PgradC(k,l,j) = PgradC(k,l,j)-aux
9676 if (nfgtasks.gt.1) then
9677 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9678 & MPI_SUM,king,FG_COMM,IERR)
9679 if (fg_rank.eq.king) then
9681 Pcalc(k) = Pcalc_(k)
9684 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9685 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9686 if (fg_rank.eq.king) then
9690 PgradC(k,l,i) = PgradC_(k,l,i)
9696 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9697 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9698 if (fg_rank.eq.king) then
9702 PgradX(k,l,i) = PgradX_(k,l,i)
9711 if (fg_rank.eq.king) then
9715 Cnorm = Cnorm + Pcalc(k)
9717 Esaxs_constr = dlog(Cnorm)-wsaxs0
9719 if (Pcalc(k).gt.0.0d0)
9720 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9722 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9726 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9736 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9737 auxC1 = auxC1+PgradC(k,l,i)
9739 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9740 auxX1 = auxX1+PgradX(k,l,i)
9743 gsaxsC(l,i) = auxC - auxC1/Cnorm
9745 gsaxsX(l,i) = auxX - auxX1/Cnorm
9747 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9748 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9756 c----------------------------------------------------------------------------
9757 subroutine e_saxsC(Esaxs_constr)
9759 include 'DIMENSIONS'
9760 include 'DIMENSIONS.ZSCOPT'
9761 include 'DIMENSIONS.FREE'
9764 include "COMMON.SETUP"
9767 include 'COMMON.SBRIDGE'
9768 include 'COMMON.CHAIN'
9769 include 'COMMON.GEO'
9770 include 'COMMON.LOCAL'
9771 include 'COMMON.INTERACT'
9772 include 'COMMON.VAR'
9773 include 'COMMON.IOUNITS'
9774 include 'COMMON.DERIV'
9775 include 'COMMON.CONTROL'
9776 include 'COMMON.NAMES'
9777 include 'COMMON.FFIELD'
9778 include 'COMMON.LANGEVIN'
9780 double precision Esaxs_constr
9781 integer i,iint,j,k,l
9782 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot
9784 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9786 double precision dk,dijCASPH,dijSCSPH,
9787 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9788 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
9790 c SAXS restraint penalty function
9792 write(iout,*) "------- SAXS penalty function start -------"
9793 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
9794 & " isaxs_end",isaxs_end
9795 write (iout,*) "nnt",nnt," ntc",nct
9797 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9798 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9801 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9804 Esaxs_constr = 0.0d0
9806 do j=isaxs_start,isaxs_end
9818 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9820 if (itype(i).ne.10) then
9822 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9825 sigma2CA=2.0d0/pstok**2
9826 sigma2SC=4.0d0/restok(itype(i))**2
9827 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9828 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9829 Pcalc = Pcalc+expCASPH+expSCSPH
9831 write(*,*) "processor i j Pcalc",
9832 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc
9834 CASPHgrad = sigma2CA*expCASPH
9835 SCSPHgrad = sigma2SC*expSCSPH
9837 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9838 PgradX(l,i) = PgradX(l,i) + aux
9839 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9844 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc
9845 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc
9848 logPtot = logPtot - dlog(Pcalc)
9849 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc),
9850 c & " logPtot",logPtot
9853 if (nfgtasks.gt.1) then
9854 c write (iout,*) "logPtot before reduction",logPtot
9855 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9856 & MPI_SUM,king,FG_COMM,IERR)
9858 c write (iout,*) "logPtot after reduction",logPtot
9859 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9860 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9861 if (fg_rank.eq.king) then
9864 gsaxsC(l,i) = gsaxsC_(l,i)
9868 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9869 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9870 if (fg_rank.eq.king) then
9873 gsaxsX(l,i) = gsaxsX_(l,i)
9879 Esaxs_constr = logPtot