1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
9 cMS$ATTRIBUTES C :: proc_proc
12 include 'COMMON.IOUNITS'
13 double precision energia(0:max_ene),energia1(0:max_ene+1)
14 include 'COMMON.FFIELD'
15 include 'COMMON.DERIV'
16 include 'COMMON.INTERACT'
17 include 'COMMON.SBRIDGE'
18 include 'COMMON.CHAIN'
19 include 'COMMON.SHIELD'
20 include 'COMMON.CONTROL'
21 include 'COMMON.TORCNSTR'
22 double precision fact(6)
23 c write(iout, '(a,i2)')'Calling etotal ipot=',ipot
25 cd print *,'nnt=',nnt,' nct=',nct
27 C Compute the side-chain and electrostatic interaction energy
29 goto (101,102,103,104,105) ipot
30 C Lennard-Jones potential.
31 101 call elj(evdw,evdw_t)
32 cd print '(a)','Exit ELJ'
34 C Lennard-Jones-Kihara potential (shifted).
35 102 call eljk(evdw,evdw_t)
37 C Berne-Pechukas potential (dilated LJ, angular dependence).
38 103 call ebp(evdw,evdw_t)
40 C Gay-Berne potential (shifted LJ, angular dependence).
41 104 call egb(evdw,evdw_t)
43 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
44 105 call egbv(evdw,evdw_t)
46 C Calculate electrostatic (H-bonding) energy of the main chain.
49 c write (iout,*) "Sidechain"
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'
61 C Calculate excluded-volume interaction energy between peptide groups
64 call escp(evdw2,evdw2_14)
66 c Calculate the bond-stretching energy
70 C write (iout,*) "estr",estr
72 C Calculate the disulfide-bridge and other energy and the contributions
73 C from other distance constraints.
74 cd print *,'Calling EHPB'
76 cd print *,'EHPB exitted succesfully.'
78 C Calculate the virtual-bond-angle energy.
80 C print *,'Bend energy finished.'
82 if (tor_mode.eq.0) then
85 C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
93 if (with_theta_constr) call etheta_constr(ethetacnstr)
94 c call ebend(ebe,ethetacnstr)
95 cd print *,'Bend energy finished.'
97 C Calculate the SC local energy.
100 C print *,'SCLOC energy finished.'
102 C Calculate the virtual-bond torsional energy.
104 if (wtor.gt.0.0d0) then
105 if (tor_mode.eq.0) then
106 call etor(etors,fact(1))
108 C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
110 call etor_kcc(etors,fact(1))
116 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
117 c print *,"Processor",myrank," computed Utor"
119 C 6/23/01 Calculate double-torsional energy
121 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
122 call etor_d(etors_d,fact(2))
126 c print *,"Processor",myrank," computed Utord"
128 call eback_sc_corr(esccor)
130 if (wliptran.gt.0) then
131 call Eliptransfer(eliptran)
135 C 12/1/95 Multi-body terms
139 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
140 & .or. wturn6.gt.0.0d0) then
141 c write(iout,*)"calling multibody_eello"
142 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
143 c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
144 c write (iout,*) ecorr,ecorr5,ecorr6,eturn6
151 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
152 c write (iout,*) "Calling multibody_hbond"
153 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
155 c write (iout,*) "NSAXS",nsaxs
156 if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
157 call e_saxs(Esaxs_constr)
158 c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
159 else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then
160 call e_saxsC(Esaxs_constr)
161 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
177 & +wliptran*eliptran+wsaxs*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 'COMMON.IOUNITS'
420 include 'COMMON.FFIELD'
421 include 'COMMON.SBRIDGE'
422 double precision energia(0:max_ene),fact(6)
424 evdw=energia(1)+fact(6)*energia(21)
426 evdw2=energia(2)+energia(17)
438 eello_turn3=energia(8)
439 eello_turn4=energia(9)
440 eello_turn6=energia(10)
447 edihcnstr=energia(20)
449 ethetacnstr=energia(24)
453 if (shield_mode.gt.0) then
454 write (iout,10) evdw,wsc*fact(1),evdw2,wscp*fact(1),ees,
455 & welec*fact(1),evdw1,wvdwpp*fact(1),
456 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
457 & etors_d,wtor_d*fact(2),ehpb,wstrain,
458 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
459 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
460 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
461 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
462 & eliptran,wliptran,esaxs,wsaxs,etot
464 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
466 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
467 & etors_d,wtor_d*fact(2),ehpb,wstrain,
468 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
469 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
470 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
471 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
472 & eliptran,wliptran,esaxs,wsaxs,etot
474 10 format (/'Virtual-chain energies:'//
475 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
476 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
477 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
478 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
479 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
480 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
481 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
482 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
483 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
484 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
485 & ' (SS bridges & dist. cnstr.)'/
486 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
487 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
488 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
489 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
490 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
491 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
492 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
493 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
494 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
495 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
496 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
497 & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/
498 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/
499 & 'ETOT= ',1pE16.6,' (total)')
501 if (shield_mode.gt.0) then
502 write (iout,10) evdw,wsc*fact(1),evdw2,wscp*fact(2),ees,
503 & welec*fact(1),estr,wbond,
504 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
505 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
506 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
507 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
508 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
509 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,esaxs,wsaxs,etot
511 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
512 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
513 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
514 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
515 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
516 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
517 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,esaxs,wsaxs,etot
519 10 format (/'Virtual-chain energies:'//
520 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
521 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
522 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
523 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
524 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
525 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
526 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
527 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
528 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
529 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
530 & ' (SS bridges & dist. cnstr.)'/
531 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
532 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
533 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
534 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
535 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
536 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
537 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
538 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
539 & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/
540 & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/
541 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
542 & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/
543 & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/
544 & 'ETOT= ',1pE16.6,' (total)')
548 C-----------------------------------------------------------------------
549 subroutine elj(evdw,evdw_t)
551 C This subroutine calculates the interaction energy of nonbonded side chains
552 C assuming the LJ potential of interaction.
554 implicit real*8 (a-h,o-z)
556 include "DIMENSIONS.COMPAR"
557 parameter (accur=1.0d-10)
560 include 'COMMON.LOCAL'
561 include 'COMMON.CHAIN'
562 include 'COMMON.DERIV'
563 include 'COMMON.INTERACT'
564 include 'COMMON.TORSION'
565 include 'COMMON.SBRIDGE'
566 include 'COMMON.NAMES'
567 include 'COMMON.IOUNITS'
568 include 'COMMON.CONTACTS'
572 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
576 c eneps_temp(j,i)=0.0d0
585 if (itypi.eq.ntyp1) cycle
586 itypi1=iabs(itype(i+1))
593 C Calculate SC interaction energy.
596 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
597 cd & 'iend=',iend(i,iint)
598 do j=istart(i,iint),iend(i,iint)
600 if (itypj.eq.ntyp1) cycle
604 C Change 12/1/95 to calculate four-body interactions
605 rij=xj*xj+yj*yj+zj*zj
607 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
608 eps0ij=eps(itypi,itypj)
613 ij=icant(itypi,itypj)
615 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
616 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
619 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
620 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
621 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
622 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
623 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
624 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
625 if (bb.gt.0.0d0) then
632 C Calculate the components of the gradient in DC and X
634 fac=-rrij*(e1+evdwij)
639 gvdwx(k,i)=gvdwx(k,i)-gg(k)
640 gvdwx(k,j)=gvdwx(k,j)+gg(k)
644 gvdwc(l,k)=gvdwc(l,k)+gg(l)
649 C 12/1/95, revised on 5/20/97
651 C Calculate the contact function. The ith column of the array JCONT will
652 C contain the numbers of atoms that make contacts with the atom I (of numbers
653 C greater than I). The arrays FACONT and GACONT will contain the values of
654 C the contact function and its derivative.
656 C Uncomment next line, if the correlation interactions include EVDW explicitly.
657 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
658 C Uncomment next line, if the correlation interactions are contact function only
659 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
661 sigij=sigma(itypi,itypj)
662 r0ij=rs0(itypi,itypj)
664 C Check whether the SC's are not too far to make a contact.
667 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
668 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
670 if (fcont.gt.0.0D0) then
671 C If the SC-SC distance if close to sigma, apply spline.
672 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
673 cAdam & fcont1,fprimcont1)
674 cAdam fcont1=1.0d0-fcont1
675 cAdam if (fcont1.gt.0.0d0) then
676 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
677 cAdam fcont=fcont*fcont1
679 C Uncomment following 4 lines to have the geometric average of the epsilon0's
680 cga eps0ij=1.0d0/dsqrt(eps0ij)
682 cga gg(k)=gg(k)*eps0ij
684 cga eps0ij=-evdwij*eps0ij
685 C Uncomment for AL's type of SC correlation interactions.
687 num_conti=num_conti+1
689 facont(num_conti,i)=fcont*eps0ij
690 fprimcont=eps0ij*fprimcont/rij
692 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
693 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
694 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
695 C Uncomment following 3 lines for Skolnick's type of SC correlation.
696 gacont(1,num_conti,i)=-fprimcont*xj
697 gacont(2,num_conti,i)=-fprimcont*yj
698 gacont(3,num_conti,i)=-fprimcont*zj
699 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
700 cd write (iout,'(2i3,3f10.5)')
701 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
707 num_cont(i)=num_conti
712 gvdwc(j,i)=expon*gvdwc(j,i)
713 gvdwx(j,i)=expon*gvdwx(j,i)
717 C******************************************************************************
721 C To save time, the factor of EXPON has been extracted from ALL components
722 C of GVDWC and GRADX. Remember to multiply them by this factor before further
725 C******************************************************************************
728 C-----------------------------------------------------------------------------
729 subroutine eljk(evdw,evdw_t)
731 C This subroutine calculates the interaction energy of nonbonded side chains
732 C assuming the LJK potential of interaction.
734 implicit real*8 (a-h,o-z)
736 include "DIMENSIONS.COMPAR"
739 include 'COMMON.LOCAL'
740 include 'COMMON.CHAIN'
741 include 'COMMON.DERIV'
742 include 'COMMON.INTERACT'
743 include 'COMMON.IOUNITS'
744 include 'COMMON.NAMES'
749 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
752 c eneps_temp(j,i)=0.0d0
759 if (itypi.eq.ntyp1) cycle
760 itypi1=iabs(itype(i+1))
765 C Calculate SC interaction energy.
768 do j=istart(i,iint),iend(i,iint)
770 if (itypj.eq.ntyp1) cycle
774 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
776 e_augm=augm(itypi,itypj)*fac_augm
779 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
780 fac=r_shift_inv**expon
784 ij=icant(itypi,itypj)
785 c eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
786 c & /dabs(eps(itypi,itypj))
787 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
788 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
789 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
790 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
791 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
792 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
793 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
794 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
795 if (bb.gt.0.0d0) then
802 C Calculate the components of the gradient in DC and X
804 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
809 gvdwx(k,i)=gvdwx(k,i)-gg(k)
810 gvdwx(k,j)=gvdwx(k,j)+gg(k)
814 gvdwc(l,k)=gvdwc(l,k)+gg(l)
824 gvdwc(j,i)=expon*gvdwc(j,i)
825 gvdwx(j,i)=expon*gvdwx(j,i)
831 C-----------------------------------------------------------------------------
832 subroutine ebp(evdw,evdw_t)
834 C This subroutine calculates the interaction energy of nonbonded side chains
835 C assuming the Berne-Pechukas potential of interaction.
837 implicit real*8 (a-h,o-z)
839 include "DIMENSIONS.COMPAR"
842 include 'COMMON.LOCAL'
843 include 'COMMON.CHAIN'
844 include 'COMMON.DERIV'
845 include 'COMMON.NAMES'
846 include 'COMMON.INTERACT'
847 include 'COMMON.IOUNITS'
848 include 'COMMON.CALC'
850 c double precision rrsave(maxdim)
856 c eneps_temp(j,i)=0.0d0
861 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
862 c if (icall.eq.0) then
870 if (itypi.eq.ntyp1) cycle
871 itypi1=iabs(itype(i+1))
875 dxi=dc_norm(1,nres+i)
876 dyi=dc_norm(2,nres+i)
877 dzi=dc_norm(3,nres+i)
878 dsci_inv=vbld_inv(i+nres)
880 C Calculate SC interaction energy.
883 do j=istart(i,iint),iend(i,iint)
886 if (itypj.eq.ntyp1) cycle
887 dscj_inv=vbld_inv(j+nres)
888 chi1=chi(itypi,itypj)
889 chi2=chi(itypj,itypi)
896 alf12=0.5D0*(alf1+alf2)
897 C For diagnostics only!!!
910 dxj=dc_norm(1,nres+j)
911 dyj=dc_norm(2,nres+j)
912 dzj=dc_norm(3,nres+j)
913 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
914 cd if (icall.eq.0) then
920 C Calculate the angle-dependent terms of energy & contributions to derivatives.
922 C Calculate whole angle-dependent part of epsilon and contributions
924 fac=(rrij*sigsq)**expon2
927 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
928 eps2der=evdwij*eps3rt
929 eps3der=evdwij*eps2rt
930 evdwij=evdwij*eps2rt*eps3rt
931 ij=icant(itypi,itypj)
932 aux=eps1*eps2rt**2*eps3rt**2
933 c eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
934 c & /dabs(eps(itypi,itypj))
935 c eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
936 if (bb.gt.0.0d0) then
943 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
945 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
946 & restyp(itypi),i,restyp(itypj),j,
947 & epsi,sigm,chi1,chi2,chip1,chip2,
948 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
949 & om1,om2,om12,1.0D0/dsqrt(rrij),
952 C Calculate gradient components.
953 e1=e1*eps1*eps2rt**2*eps3rt**2
954 fac=-expon*(e1+evdwij)
957 C Calculate radial part of the gradient
961 C Calculate the angular part of the gradient and sum add the contributions
962 C to the appropriate components of the Cartesian gradient.
971 C-----------------------------------------------------------------------------
972 subroutine egb(evdw,evdw_t)
974 C This subroutine calculates the interaction energy of nonbonded side chains
975 C assuming the Gay-Berne potential of interaction.
977 implicit real*8 (a-h,o-z)
979 include "DIMENSIONS.COMPAR"
982 include 'COMMON.LOCAL'
983 include 'COMMON.CHAIN'
984 include 'COMMON.DERIV'
985 include 'COMMON.NAMES'
986 include 'COMMON.INTERACT'
987 include 'COMMON.IOUNITS'
988 include 'COMMON.CALC'
989 include 'COMMON.SBRIDGE'
992 integer icant,xshift,yshift,zshift
996 c eneps_temp(j,i)=0.0d0
999 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1003 c if (icall.gt.0) lprn=.true.
1005 do i=iatsc_s,iatsc_e
1006 itypi=iabs(itype(i))
1007 if (itypi.eq.ntyp1) cycle
1008 itypi1=iabs(itype(i+1))
1012 C returning the ith atom to box
1014 if (xi.lt.0) xi=xi+boxxsize
1016 if (yi.lt.0) yi=yi+boxysize
1018 if (zi.lt.0) zi=zi+boxzsize
1019 if ((zi.gt.bordlipbot)
1020 &.and.(zi.lt.bordliptop)) then
1021 C the energy transfer exist
1022 if (zi.lt.buflipbot) then
1023 C what fraction I am in
1025 & ((zi-bordlipbot)/lipbufthick)
1026 C lipbufthick is thickenes of lipid buffore
1027 sslipi=sscalelip(fracinbuf)
1028 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1029 elseif (zi.gt.bufliptop) then
1030 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1031 sslipi=sscalelip(fracinbuf)
1032 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1042 dxi=dc_norm(1,nres+i)
1043 dyi=dc_norm(2,nres+i)
1044 dzi=dc_norm(3,nres+i)
1045 dsci_inv=vbld_inv(i+nres)
1047 C Calculate SC interaction energy.
1049 do iint=1,nint_gr(i)
1050 do j=istart(i,iint),iend(i,iint)
1051 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1052 call dyn_ssbond_ene(i,j,evdwij)
1054 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1055 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1056 C triple bond artifac removal
1057 do k=j+1,iend(i,iint)
1058 C search over all next residues
1059 if (dyn_ss_mask(k)) then
1060 C check if they are cysteins
1061 C write(iout,*) 'k=',k
1062 call triple_ssbond_ene(i,j,k,evdwij)
1063 C call the energy function that removes the artifical triple disulfide
1064 C bond the soubroutine is located in ssMD.F
1066 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1067 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1068 endif!dyn_ss_mask(k)
1072 itypj=iabs(itype(j))
1073 if (itypj.eq.ntyp1) cycle
1074 dscj_inv=vbld_inv(j+nres)
1075 sig0ij=sigma(itypi,itypj)
1076 chi1=chi(itypi,itypj)
1077 chi2=chi(itypj,itypi)
1084 alf12=0.5D0*(alf1+alf2)
1085 C For diagnostics only!!!
1098 C returning jth atom to box
1100 if (xj.lt.0) xj=xj+boxxsize
1102 if (yj.lt.0) yj=yj+boxysize
1104 if (zj.lt.0) zj=zj+boxzsize
1105 if ((zj.gt.bordlipbot)
1106 &.and.(zj.lt.bordliptop)) then
1107 C the energy transfer exist
1108 if (zj.lt.buflipbot) then
1109 C what fraction I am in
1111 & ((zj-bordlipbot)/lipbufthick)
1112 C lipbufthick is thickenes of lipid buffore
1113 sslipj=sscalelip(fracinbuf)
1114 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1115 elseif (zj.gt.bufliptop) then
1116 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1117 sslipj=sscalelip(fracinbuf)
1118 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1127 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1128 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1129 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1130 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1131 C if (aa.ne.aa_aq(itypi,itypj)) then
1133 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1134 C & bb_aq(itypi,itypj)-bb,
1138 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1139 C checking the distance
1140 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1145 C finding the closest
1149 xj=xj_safe+xshift*boxxsize
1150 yj=yj_safe+yshift*boxysize
1151 zj=zj_safe+zshift*boxzsize
1152 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1153 if(dist_temp.lt.dist_init) then
1163 if (subchap.eq.1) then
1173 dxj=dc_norm(1,nres+j)
1174 dyj=dc_norm(2,nres+j)
1175 dzj=dc_norm(3,nres+j)
1176 c write (iout,*) i,j,xj,yj,zj
1177 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1179 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1180 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1181 if (sss.le.0.0) cycle
1182 C Calculate angle-dependent terms of energy and contributions to their
1187 sig=sig0ij*dsqrt(sigsq)
1188 rij_shift=1.0D0/rij-sig+sig0ij
1189 C I hate to put IF's in the loops, but here don't have another choice!!!!
1190 if (rij_shift.le.0.0D0) then
1195 c---------------------------------------------------------------
1196 rij_shift=1.0D0/rij_shift
1197 fac=rij_shift**expon
1200 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1201 eps2der=evdwij*eps3rt
1202 eps3der=evdwij*eps2rt
1203 evdwij=evdwij*eps2rt*eps3rt
1205 evdw=evdw+evdwij*sss
1207 evdw_t=evdw_t+evdwij*sss
1209 ij=icant(itypi,itypj)
1210 aux=eps1*eps2rt**2*eps3rt**2
1211 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1212 c & /dabs(eps(itypi,itypj))
1213 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1214 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1215 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1216 c & aux*e2/eps(itypi,itypj)
1218 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1222 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1223 & restyp(itypi),i,restyp(itypj),j,
1224 & epsi,sigm,chi1,chi2,chip1,chip2,
1225 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1226 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1228 write (iout,*) "partial sum", evdw, evdw_t
1233 C Calculate gradient components.
1234 e1=e1*eps1*eps2rt**2*eps3rt**2
1235 fac=-expon*(e1+evdwij)*rij_shift
1238 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1239 C Calculate the radial part of the gradient
1243 C Calculate angular part of the gradient.
1246 C write(iout,*) "partial sum", evdw, evdw_t
1253 C-----------------------------------------------------------------------------
1254 subroutine egbv(evdw,evdw_t)
1256 C This subroutine calculates the interaction energy of nonbonded side chains
1257 C assuming the Gay-Berne-Vorobjev potential of interaction.
1259 implicit real*8 (a-h,o-z)
1260 include 'DIMENSIONS'
1261 include "DIMENSIONS.COMPAR"
1262 include 'COMMON.GEO'
1263 include 'COMMON.VAR'
1264 include 'COMMON.LOCAL'
1265 include 'COMMON.CHAIN'
1266 include 'COMMON.DERIV'
1267 include 'COMMON.NAMES'
1268 include 'COMMON.INTERACT'
1269 include 'COMMON.IOUNITS'
1270 include 'COMMON.CALC'
1271 common /srutu/ icall
1277 c eneps_temp(j,i)=0.0d0
1282 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1285 c if (icall.gt.0) lprn=.true.
1287 do i=iatsc_s,iatsc_e
1288 itypi=iabs(itype(i))
1289 if (itypi.eq.ntyp1) cycle
1290 itypi1=iabs(itype(i+1))
1294 dxi=dc_norm(1,nres+i)
1295 dyi=dc_norm(2,nres+i)
1296 dzi=dc_norm(3,nres+i)
1297 dsci_inv=vbld_inv(i+nres)
1299 C Calculate SC interaction energy.
1301 do iint=1,nint_gr(i)
1302 do j=istart(i,iint),iend(i,iint)
1304 itypj=iabs(itype(j))
1305 if (itypj.eq.ntyp1) cycle
1306 dscj_inv=vbld_inv(j+nres)
1307 sig0ij=sigma(itypi,itypj)
1308 r0ij=r0(itypi,itypj)
1309 chi1=chi(itypi,itypj)
1310 chi2=chi(itypj,itypi)
1317 alf12=0.5D0*(alf1+alf2)
1318 C For diagnostics only!!!
1331 dxj=dc_norm(1,nres+j)
1332 dyj=dc_norm(2,nres+j)
1333 dzj=dc_norm(3,nres+j)
1334 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1336 C Calculate angle-dependent terms of energy and contributions to their
1340 sig=sig0ij*dsqrt(sigsq)
1341 rij_shift=1.0D0/rij-sig+r0ij
1342 C I hate to put IF's in the loops, but here don't have another choice!!!!
1343 if (rij_shift.le.0.0D0) then
1348 c---------------------------------------------------------------
1349 rij_shift=1.0D0/rij_shift
1350 fac=rij_shift**expon
1353 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1354 eps2der=evdwij*eps3rt
1355 eps3der=evdwij*eps2rt
1356 fac_augm=rrij**expon
1357 e_augm=augm(itypi,itypj)*fac_augm
1358 evdwij=evdwij*eps2rt*eps3rt
1359 if (bb.gt.0.0d0) then
1360 evdw=evdw+evdwij+e_augm
1362 evdw_t=evdw_t+evdwij+e_augm
1364 ij=icant(itypi,itypj)
1365 aux=eps1*eps2rt**2*eps3rt**2
1366 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1367 c & /dabs(eps(itypi,itypj))
1368 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1369 c eneps_temp(ij)=eneps_temp(ij)
1370 c & +(evdwij+e_augm)/eps(itypi,itypj)
1372 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1373 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1374 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1375 c & restyp(itypi),i,restyp(itypj),j,
1376 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1377 c & chi1,chi2,chip1,chip2,
1378 c & eps1,eps2rt**2,eps3rt**2,
1379 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1383 C Calculate gradient components.
1384 e1=e1*eps1*eps2rt**2*eps3rt**2
1385 fac=-expon*(e1+evdwij)*rij_shift
1387 fac=rij*fac-2*expon*rrij*e_augm
1388 C Calculate the radial part of the gradient
1392 C Calculate angular part of the gradient.
1400 C-----------------------------------------------------------------------------
1401 subroutine sc_angular
1402 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1403 C om12. Called by ebp, egb, and egbv.
1405 include 'COMMON.CALC'
1409 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1410 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1411 om12=dxi*dxj+dyi*dyj+dzi*dzj
1413 C Calculate eps1(om12) and its derivative in om12
1414 faceps1=1.0D0-om12*chiom12
1415 faceps1_inv=1.0D0/faceps1
1416 eps1=dsqrt(faceps1_inv)
1417 C Following variable is eps1*deps1/dom12
1418 eps1_om12=faceps1_inv*chiom12
1419 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1424 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1425 sigsq=1.0D0-facsig*faceps1_inv
1426 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1427 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1428 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1429 C Calculate eps2 and its derivatives in om1, om2, and om12.
1432 chipom12=chip12*om12
1433 facp=1.0D0-om12*chipom12
1435 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1436 C Following variable is the square root of eps2
1437 eps2rt=1.0D0-facp1*facp_inv
1438 C Following three variables are the derivatives of the square root of eps
1439 C in om1, om2, and om12.
1440 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1441 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1442 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1443 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1444 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1445 C Calculate whole angle-dependent part of epsilon and contributions
1446 C to its derivatives
1449 C----------------------------------------------------------------------------
1451 implicit real*8 (a-h,o-z)
1452 include 'DIMENSIONS'
1453 include 'COMMON.CHAIN'
1454 include 'COMMON.DERIV'
1455 include 'COMMON.CALC'
1456 double precision dcosom1(3),dcosom2(3)
1457 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1458 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1459 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1460 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1462 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1463 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1466 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1469 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1470 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1471 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1472 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1473 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1474 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1477 C Calculate the components of the gradient in DC and X
1481 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1486 c------------------------------------------------------------------------------
1487 subroutine vec_and_deriv
1488 implicit real*8 (a-h,o-z)
1489 include 'DIMENSIONS'
1490 include 'COMMON.IOUNITS'
1491 include 'COMMON.GEO'
1492 include 'COMMON.VAR'
1493 include 'COMMON.LOCAL'
1494 include 'COMMON.CHAIN'
1495 include 'COMMON.VECTORS'
1496 include 'COMMON.DERIV'
1497 include 'COMMON.INTERACT'
1498 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1499 C Compute the local reference systems. For reference system (i), the
1500 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1501 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1503 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1504 if (i.eq.nres-1) then
1505 C Case of the last full residue
1506 C Compute the Z-axis
1507 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1508 costh=dcos(pi-theta(nres))
1509 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1510 c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1),
1516 C Compute the derivatives of uz
1518 uzder(2,1,1)=-dc_norm(3,i-1)
1519 uzder(3,1,1)= dc_norm(2,i-1)
1520 uzder(1,2,1)= dc_norm(3,i-1)
1522 uzder(3,2,1)=-dc_norm(1,i-1)
1523 uzder(1,3,1)=-dc_norm(2,i-1)
1524 uzder(2,3,1)= dc_norm(1,i-1)
1527 uzder(2,1,2)= dc_norm(3,i)
1528 uzder(3,1,2)=-dc_norm(2,i)
1529 uzder(1,2,2)=-dc_norm(3,i)
1531 uzder(3,2,2)= dc_norm(1,i)
1532 uzder(1,3,2)= dc_norm(2,i)
1533 uzder(2,3,2)=-dc_norm(1,i)
1536 C Compute the Y-axis
1539 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1542 C Compute the derivatives of uy
1545 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1546 & -dc_norm(k,i)*dc_norm(j,i-1)
1547 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1549 uyder(j,j,1)=uyder(j,j,1)-costh
1550 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1555 uygrad(l,k,j,i)=uyder(l,k,j)
1556 uzgrad(l,k,j,i)=uzder(l,k,j)
1560 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1561 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1562 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1563 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1567 C Compute the Z-axis
1568 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1569 costh=dcos(pi-theta(i+2))
1570 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1575 C Compute the derivatives of uz
1577 uzder(2,1,1)=-dc_norm(3,i+1)
1578 uzder(3,1,1)= dc_norm(2,i+1)
1579 uzder(1,2,1)= dc_norm(3,i+1)
1581 uzder(3,2,1)=-dc_norm(1,i+1)
1582 uzder(1,3,1)=-dc_norm(2,i+1)
1583 uzder(2,3,1)= dc_norm(1,i+1)
1586 uzder(2,1,2)= dc_norm(3,i)
1587 uzder(3,1,2)=-dc_norm(2,i)
1588 uzder(1,2,2)=-dc_norm(3,i)
1590 uzder(3,2,2)= dc_norm(1,i)
1591 uzder(1,3,2)= dc_norm(2,i)
1592 uzder(2,3,2)=-dc_norm(1,i)
1595 C Compute the Y-axis
1598 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1601 C Compute the derivatives of uy
1604 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1605 & -dc_norm(k,i)*dc_norm(j,i+1)
1606 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1608 uyder(j,j,1)=uyder(j,j,1)-costh
1609 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1614 uygrad(l,k,j,i)=uyder(l,k,j)
1615 uzgrad(l,k,j,i)=uzder(l,k,j)
1619 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1620 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1621 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1622 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1628 vbld_inv_temp(1)=vbld_inv(i+1)
1629 if (i.lt.nres-1) then
1630 vbld_inv_temp(2)=vbld_inv(i+2)
1632 vbld_inv_temp(2)=vbld_inv(i)
1637 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1638 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1646 C--------------------------------------------------------------------------
1647 subroutine set_matrices
1648 implicit real*8 (a-h,o-z)
1649 include 'DIMENSIONS'
1653 integer status(MPI_STATUS_SIZE)
1655 include 'COMMON.IOUNITS'
1656 include 'COMMON.GEO'
1657 include 'COMMON.VAR'
1658 include 'COMMON.LOCAL'
1659 include 'COMMON.CHAIN'
1660 include 'COMMON.DERIV'
1661 include 'COMMON.INTERACT'
1662 include 'COMMON.CONTACTS'
1663 include 'COMMON.TORSION'
1664 include 'COMMON.VECTORS'
1665 include 'COMMON.FFIELD'
1666 double precision auxvec(2),auxmat(2,2)
1668 C Compute the virtual-bond-torsional-angle dependent quantities needed
1669 C to calculate the el-loc multibody terms of various order.
1671 c write(iout,*) 'SET_MATRICES nphi=',nphi,nres
1673 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1674 iti = itype2loc(itype(i-2))
1678 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1679 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1680 iti1 = itype2loc(itype(i-1))
1685 cost1=dcos(theta(i-1))
1686 sint1=dsin(theta(i-1))
1688 sint1cub=sint1sq*sint1
1689 sint1cost1=2*sint1*cost1
1691 write (iout,*) "bnew1",i,iti
1692 write (iout,*) (bnew1(k,1,iti),k=1,3)
1693 write (iout,*) (bnew1(k,2,iti),k=1,3)
1694 write (iout,*) "bnew2",i,iti
1695 write (iout,*) (bnew2(k,1,iti),k=1,3)
1696 write (iout,*) (bnew2(k,2,iti),k=1,3)
1699 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
1701 gtb1(k,i-2)=cost1*b1k-sint1sq*
1702 & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
1703 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
1705 if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq*
1706 & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
1709 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
1710 cc(1,k,i-2)=sint1sq*aux
1711 if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*
1712 & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
1713 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
1714 dd(1,k,i-2)=sint1sq*aux
1715 if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*
1716 & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
1718 cc(2,1,i-2)=cc(1,2,i-2)
1719 cc(2,2,i-2)=-cc(1,1,i-2)
1720 gtcc(2,1,i-2)=gtcc(1,2,i-2)
1721 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
1722 dd(2,1,i-2)=dd(1,2,i-2)
1723 dd(2,2,i-2)=-dd(1,1,i-2)
1724 gtdd(2,1,i-2)=gtdd(1,2,i-2)
1725 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
1728 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
1729 EE(l,k,i-2)=sint1sq*aux
1731 & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
1734 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
1735 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
1736 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
1737 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
1739 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
1740 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
1741 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
1743 c b1tilde(1,i-2)=b1(1,i-2)
1744 c b1tilde(2,i-2)=-b1(2,i-2)
1745 c b2tilde(1,i-2)=b2(1,i-2)
1746 c b2tilde(2,i-2)=-b2(2,i-2)
1748 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
1749 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1750 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1751 write (iout,*) 'theta=', theta(i-1)
1754 c if (i.gt. nnt+2 .and. i.lt.nct+2) then
1755 c iti = itype2loc(itype(i-2))
1759 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1760 c if (i.gt. nnt+1 .and. i.lt.nct+1) then
1761 c iti1 = itype2loc(itype(i-1))
1771 CC(k,l,i-2)=ccold(k,l,iti)
1772 DD(k,l,i-2)=ddold(k,l,iti)
1773 EE(k,l,i-2)=eeold(k,l,iti)
1777 b1tilde(1,i-2)= b1(1,i-2)
1778 b1tilde(2,i-2)=-b1(2,i-2)
1779 b2tilde(1,i-2)= b2(1,i-2)
1780 b2tilde(2,i-2)=-b2(2,i-2)
1782 Ctilde(1,1,i-2)= CC(1,1,i-2)
1783 Ctilde(1,2,i-2)= CC(1,2,i-2)
1784 Ctilde(2,1,i-2)=-CC(2,1,i-2)
1785 Ctilde(2,2,i-2)=-CC(2,2,i-2)
1787 Dtilde(1,1,i-2)= DD(1,1,i-2)
1788 Dtilde(1,2,i-2)= DD(1,2,i-2)
1789 Dtilde(2,1,i-2)=-DD(2,1,i-2)
1790 Dtilde(2,2,i-2)=-DD(2,2,i-2)
1791 c write(iout,*) "i",i," iti",iti
1792 c write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
1793 c write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
1796 if (i .lt. nres+1) then
1833 if (i .gt. 3 .and. i .lt. nres+1) then
1834 obrot_der(1,i-2)=-sin1
1835 obrot_der(2,i-2)= cos1
1836 Ugder(1,1,i-2)= sin1
1837 Ugder(1,2,i-2)=-cos1
1838 Ugder(2,1,i-2)=-cos1
1839 Ugder(2,2,i-2)=-sin1
1842 obrot2_der(1,i-2)=-dwasin2
1843 obrot2_der(2,i-2)= dwacos2
1844 Ug2der(1,1,i-2)= dwasin2
1845 Ug2der(1,2,i-2)=-dwacos2
1846 Ug2der(2,1,i-2)=-dwacos2
1847 Ug2der(2,2,i-2)=-dwasin2
1849 obrot_der(1,i-2)=0.0d0
1850 obrot_der(2,i-2)=0.0d0
1851 Ugder(1,1,i-2)=0.0d0
1852 Ugder(1,2,i-2)=0.0d0
1853 Ugder(2,1,i-2)=0.0d0
1854 Ugder(2,2,i-2)=0.0d0
1855 obrot2_der(1,i-2)=0.0d0
1856 obrot2_der(2,i-2)=0.0d0
1857 Ug2der(1,1,i-2)=0.0d0
1858 Ug2der(1,2,i-2)=0.0d0
1859 Ug2der(2,1,i-2)=0.0d0
1860 Ug2der(2,2,i-2)=0.0d0
1862 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1863 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1864 iti = itype2loc(itype(i-2))
1868 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1869 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1870 iti1 = itype2loc(itype(i-1))
1874 cd write (iout,*) '*******i',i,' iti1',iti
1875 cd write (iout,*) 'b1',b1(:,iti)
1876 cd write (iout,*) 'b2',b2(:,iti)
1877 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1878 c if (i .gt. iatel_s+2) then
1879 if (i .gt. nnt+2) then
1880 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
1882 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
1883 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
1885 c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i),
1886 c & EE(1,2,iti),EE(2,2,i)
1887 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
1888 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
1889 c write(iout,*) "Macierz EUG",
1890 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
1892 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
1894 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
1895 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
1896 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1897 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
1898 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
1909 DtUg2(l,k,i-2)=0.0d0
1913 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
1914 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
1916 muder(k,i-2)=Ub2der(k,i-2)
1918 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1919 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1920 if (itype(i-1).le.ntyp) then
1921 iti1 = itype2loc(itype(i-1))
1929 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
1932 write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1),
1933 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
1934 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
1935 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
1936 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2),
1937 & ((ee(l,k,i-2),l=1,2),k=1,2)
1939 cd write (iout,*) 'mu1',mu1(:,i-2)
1940 cd write (iout,*) 'mu2',mu2(:,i-2)
1941 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
1944 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1945 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
1946 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1947 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
1948 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1950 C Vectors and matrices dependent on a single virtual-bond dihedral.
1951 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
1952 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1953 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
1954 call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2))
1955 call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2))
1957 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1958 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
1959 call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2))
1960 call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2))
1964 C Matrices dependent on two consecutive virtual-bond dihedrals.
1965 C The order of matrices is from left to right.
1966 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
1969 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1971 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1972 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1974 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1975 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1977 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1978 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1979 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1985 C--------------------------------------------------------------------------
1986 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1988 C This subroutine calculates the average interaction energy and its gradient
1989 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1990 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1991 C The potential depends both on the distance of peptide-group centers and on
1992 C the orientation of the CA-CA virtual bonds.
1994 implicit real*8 (a-h,o-z)
1998 include 'DIMENSIONS'
1999 include 'COMMON.CONTROL'
2000 include 'COMMON.IOUNITS'
2001 include 'COMMON.GEO'
2002 include 'COMMON.VAR'
2003 include 'COMMON.LOCAL'
2004 include 'COMMON.CHAIN'
2005 include 'COMMON.DERIV'
2006 include 'COMMON.INTERACT'
2007 include 'COMMON.CONTACTS'
2008 include 'COMMON.TORSION'
2009 include 'COMMON.VECTORS'
2010 include 'COMMON.FFIELD'
2011 include 'COMMON.TIME1'
2012 include 'COMMON.SPLITELE'
2013 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2014 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2015 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2016 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2017 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2018 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2020 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2022 double precision scal_el /1.0d0/
2024 double precision scal_el /0.5d0/
2027 C 13-go grudnia roku pamietnego...
2028 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2029 & 0.0d0,1.0d0,0.0d0,
2030 & 0.0d0,0.0d0,1.0d0/
2031 cd write(iout,*) 'In EELEC'
2033 cd write(iout,*) 'Type',i
2034 cd write(iout,*) 'B1',B1(:,i)
2035 cd write(iout,*) 'B2',B2(:,i)
2036 cd write(iout,*) 'CC',CC(:,:,i)
2037 cd write(iout,*) 'DD',DD(:,:,i)
2038 cd write(iout,*) 'EE',EE(:,:,i)
2040 cd call check_vecgrad
2042 if (icheckgrad.eq.1) then
2044 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2046 dc_norm(k,i)=dc(k,i)*fac
2048 c write (iout,*) 'i',i,' fac',fac
2051 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2052 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2053 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2054 c call vec_and_deriv
2060 time_mat=time_mat+MPI_Wtime()-time01
2064 cd write (iout,*) 'i=',i
2066 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2069 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2070 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2083 cd print '(a)','Enter EELEC'
2084 c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2087 gel_loc_loc(i)=0.0d0
2092 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2094 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2096 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2097 do i=iturn3_start,iturn3_end
2099 C write(iout,*) "tu jest i",i
2100 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2101 C changes suggested by Ana to avoid out of bounds
2102 C Adam: Unnecessary: handled by iturn3_end and iturn3_start
2103 c & .or.((i+4).gt.nres)
2104 c & .or.((i-1).le.0)
2105 C end of changes by Ana
2106 C dobra zmiana wycofana
2107 & .or. itype(i+2).eq.ntyp1
2108 & .or. itype(i+3).eq.ntyp1) cycle
2109 C Adam: Instructions below will switch off existing interactions
2111 c if(itype(i-1).eq.ntyp1)cycle
2113 c if(i.LT.nres-3)then
2114 c if (itype(i+4).eq.ntyp1) cycle
2119 dx_normi=dc_norm(1,i)
2120 dy_normi=dc_norm(2,i)
2121 dz_normi=dc_norm(3,i)
2122 xmedi=c(1,i)+0.5d0*dxi
2123 ymedi=c(2,i)+0.5d0*dyi
2124 zmedi=c(3,i)+0.5d0*dzi
2125 xmedi=mod(xmedi,boxxsize)
2126 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2127 ymedi=mod(ymedi,boxysize)
2128 if (ymedi.lt.0) ymedi=ymedi+boxysize
2129 zmedi=mod(zmedi,boxzsize)
2130 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2132 call eelecij(i,i+2,ees,evdw1,eel_loc)
2133 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2134 num_cont_hb(i)=num_conti
2136 do i=iturn4_start,iturn4_end
2138 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2139 C changes suggested by Ana to avoid out of bounds
2140 c & .or.((i+5).gt.nres)
2141 c & .or.((i-1).le.0)
2142 C end of changes suggested by Ana
2143 & .or. itype(i+3).eq.ntyp1
2144 & .or. itype(i+4).eq.ntyp1
2145 c & .or. itype(i+5).eq.ntyp1
2146 c & .or. itype(i).eq.ntyp1
2147 c & .or. itype(i-1).eq.ntyp1
2152 dx_normi=dc_norm(1,i)
2153 dy_normi=dc_norm(2,i)
2154 dz_normi=dc_norm(3,i)
2155 xmedi=c(1,i)+0.5d0*dxi
2156 ymedi=c(2,i)+0.5d0*dyi
2157 zmedi=c(3,i)+0.5d0*dzi
2158 C Return atom into box, boxxsize is size of box in x dimension
2160 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2161 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2162 C Condition for being inside the proper box
2163 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
2164 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
2168 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
2169 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2170 C Condition for being inside the proper box
2171 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
2172 c & (ymedi.lt.((-0.5d0)*boxysize))) then
2176 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2177 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2178 C Condition for being inside the proper box
2179 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
2180 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
2183 xmedi=mod(xmedi,boxxsize)
2184 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2185 ymedi=mod(ymedi,boxysize)
2186 if (ymedi.lt.0) ymedi=ymedi+boxysize
2187 zmedi=mod(zmedi,boxzsize)
2188 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2190 num_conti=num_cont_hb(i)
2191 c write(iout,*) "JESTEM W PETLI"
2192 call eelecij(i,i+3,ees,evdw1,eel_loc)
2193 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2194 & call eturn4(i,eello_turn4)
2195 num_cont_hb(i)=num_conti
2197 C Loop over all neighbouring boxes
2202 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2205 do i=iatel_s,iatel_e
2208 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2209 C changes suggested by Ana to avoid out of bounds
2210 c & .or.((i+2).gt.nres)
2211 c & .or.((i-1).le.0)
2212 C end of changes by Ana
2213 c & .or. itype(i+2).eq.ntyp1
2214 c & .or. itype(i-1).eq.ntyp1
2219 dx_normi=dc_norm(1,i)
2220 dy_normi=dc_norm(2,i)
2221 dz_normi=dc_norm(3,i)
2222 xmedi=c(1,i)+0.5d0*dxi
2223 ymedi=c(2,i)+0.5d0*dyi
2224 zmedi=c(3,i)+0.5d0*dzi
2225 xmedi=mod(xmedi,boxxsize)
2226 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2227 ymedi=mod(ymedi,boxysize)
2228 if (ymedi.lt.0) ymedi=ymedi+boxysize
2229 zmedi=mod(zmedi,boxzsize)
2230 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2231 C xmedi=xmedi+xshift*boxxsize
2232 C ymedi=ymedi+yshift*boxysize
2233 C zmedi=zmedi+zshift*boxzsize
2235 C Return tom into box, boxxsize is size of box in x dimension
2237 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
2238 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
2239 C Condition for being inside the proper box
2240 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
2241 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
2245 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
2246 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
2247 C Condition for being inside the proper box
2248 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
2249 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
2253 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
2254 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
2255 cC Condition for being inside the proper box
2256 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
2257 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
2261 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2262 num_conti=num_cont_hb(i)
2264 do j=ielstart(i),ielend(i)
2266 C write (iout,*) i,j
2268 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
2269 C changes suggested by Ana to avoid out of bounds
2270 c & .or.((j+2).gt.nres)
2271 c & .or.((j-1).le.0)
2272 C end of changes by Ana
2273 c & .or.itype(j+2).eq.ntyp1
2274 c & .or.itype(j-1).eq.ntyp1
2276 call eelecij(i,j,ees,evdw1,eel_loc)
2278 num_cont_hb(i)=num_conti
2284 c write (iout,*) "Number of loop steps in EELEC:",ind
2286 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2287 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2289 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2290 ccc eel_loc=eel_loc+eello_turn3
2291 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2294 C-------------------------------------------------------------------------------
2295 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2296 implicit real*8 (a-h,o-z)
2297 include 'DIMENSIONS'
2301 include 'COMMON.CONTROL'
2302 include 'COMMON.IOUNITS'
2303 include 'COMMON.GEO'
2304 include 'COMMON.VAR'
2305 include 'COMMON.LOCAL'
2306 include 'COMMON.CHAIN'
2307 include 'COMMON.DERIV'
2308 include 'COMMON.INTERACT'
2309 include 'COMMON.CONTACTS'
2310 include 'COMMON.TORSION'
2311 include 'COMMON.VECTORS'
2312 include 'COMMON.FFIELD'
2313 include 'COMMON.TIME1'
2314 include 'COMMON.SPLITELE'
2315 include 'COMMON.SHIELD'
2316 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2317 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2318 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2319 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2320 & gmuij2(4),gmuji2(4)
2321 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2322 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2324 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2326 double precision scal_el /1.0d0/
2328 double precision scal_el /0.5d0/
2331 C 13-go grudnia roku pamietnego...
2332 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2333 & 0.0d0,1.0d0,0.0d0,
2334 & 0.0d0,0.0d0,1.0d0/
2335 integer xshift,yshift,zshift
2336 c time00=MPI_Wtime()
2337 cd write (iout,*) "eelecij",i,j
2341 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2342 aaa=app(iteli,itelj)
2343 bbb=bpp(iteli,itelj)
2344 ael6i=ael6(iteli,itelj)
2345 ael3i=ael3(iteli,itelj)
2349 dx_normj=dc_norm(1,j)
2350 dy_normj=dc_norm(2,j)
2351 dz_normj=dc_norm(3,j)
2352 C xj=c(1,j)+0.5D0*dxj-xmedi
2353 C yj=c(2,j)+0.5D0*dyj-ymedi
2354 C zj=c(3,j)+0.5D0*dzj-zmedi
2359 if (xj.lt.0) xj=xj+boxxsize
2361 if (yj.lt.0) yj=yj+boxysize
2363 if (zj.lt.0) zj=zj+boxzsize
2364 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
2365 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2373 xj=xj_safe+xshift*boxxsize
2374 yj=yj_safe+yshift*boxysize
2375 zj=zj_safe+zshift*boxzsize
2376 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2377 if(dist_temp.lt.dist_init) then
2387 if (isubchap.eq.1) then
2396 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
2398 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
2399 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
2400 C Condition for being inside the proper box
2401 c if ((xj.gt.((0.5d0)*boxxsize)).or.
2402 c & (xj.lt.((-0.5d0)*boxxsize))) then
2406 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
2407 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
2408 C Condition for being inside the proper box
2409 c if ((yj.gt.((0.5d0)*boxysize)).or.
2410 c & (yj.lt.((-0.5d0)*boxysize))) then
2414 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
2415 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
2416 C Condition for being inside the proper box
2417 c if ((zj.gt.((0.5d0)*boxzsize)).or.
2418 c & (zj.lt.((-0.5d0)*boxzsize))) then
2421 C endif !endPBC condintion
2425 rij=xj*xj+yj*yj+zj*zj
2427 sss=sscale(sqrt(rij))
2428 sssgrad=sscagrad(sqrt(rij))
2429 c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut,
2430 c & " rlamb",rlamb," sss",sss
2431 c if (sss.gt.0.0d0) then
2437 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2438 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2439 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2440 fac=cosa-3.0D0*cosb*cosg
2442 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2443 if (j.eq.i+2) ev1=scal_el*ev1
2448 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2452 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2453 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2454 if (shield_mode.gt.0) then
2457 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2458 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2467 evdw1=evdw1+evdwij*sss
2468 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2469 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2470 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2471 cd & xmedi,ymedi,zmedi,xj,yj,zj
2473 if (energy_dec) then
2474 write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)')
2476 &,iteli,itelj,aaa,evdw1,sss
2477 write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
2478 &fac_shield(i),fac_shield(j)
2482 C Calculate contributions to the Cartesian gradient.
2485 facvdw=-6*rrmij*(ev1+evdwij)*sss
2486 facel=-3*rrmij*(el1+eesij)
2493 * Radial derivatives. First process both termini of the fragment (i,j)
2499 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2500 & (shield_mode.gt.0)) then
2502 do ilist=1,ishield_list(i)
2503 iresshield=shield_list(ilist,i)
2505 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2507 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2509 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2510 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2511 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2512 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2513 C if (iresshield.gt.i) then
2514 C do ishi=i+1,iresshield-1
2515 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2516 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2520 C do ishi=iresshield,i
2521 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2522 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2528 do ilist=1,ishield_list(j)
2529 iresshield=shield_list(ilist,j)
2531 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2533 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2535 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2536 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2538 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2539 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2540 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2541 C if (iresshield.gt.j) then
2542 C do ishi=j+1,iresshield-1
2543 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2544 C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2548 C do ishi=iresshield,j
2549 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2550 C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)
2557 gshieldc(k,i)=gshieldc(k,i)+
2558 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2559 gshieldc(k,j)=gshieldc(k,j)+
2560 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2561 gshieldc(k,i-1)=gshieldc(k,i-1)+
2562 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2563 gshieldc(k,j-1)=gshieldc(k,j-1)+
2564 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2569 c ghalf=0.5D0*ggg(k)
2570 c gelc(k,i)=gelc(k,i)+ghalf
2571 c gelc(k,j)=gelc(k,j)+ghalf
2573 c 9/28/08 AL Gradient compotents will be summed only at the end
2574 C print *,"before", gelc_long(1,i), gelc_long(1,j)
2576 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2577 C & +grad_shield(k,j)*eesij/fac_shield(j)
2578 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2579 C & +grad_shield(k,i)*eesij/fac_shield(i)
2580 C gelc_long(k,i-1)=gelc_long(k,i-1)
2581 C & +grad_shield(k,i)*eesij/fac_shield(i)
2582 C gelc_long(k,j-1)=gelc_long(k,j-1)
2583 C & +grad_shield(k,j)*eesij/fac_shield(j)
2585 C print *,"bafter", gelc_long(1,i), gelc_long(1,j)
2588 * Loop over residues i+1 thru j-1.
2592 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2595 if (sss.gt.0.0) then
2596 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2597 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2598 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2605 c ghalf=0.5D0*ggg(k)
2606 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2607 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2609 c 9/28/08 AL Gradient compotents will be summed only at the end
2611 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2612 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2615 * Loop over residues i+1 thru j-1.
2619 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2625 facvdw=(ev1+evdwij)*sss
2628 fac=-3*rrmij*(facvdw+facvdw+facel)
2633 * Radial derivatives. First process both termini of the fragment (i,j)
2637 C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j)
2639 C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j)
2641 C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j)
2643 c ghalf=0.5D0*ggg(k)
2644 c gelc(k,i)=gelc(k,i)+ghalf
2645 c gelc(k,j)=gelc(k,j)+ghalf
2647 c 9/28/08 AL Gradient compotents will be summed only at the end
2649 gelc_long(k,j)=gelc(k,j)+ggg(k)
2650 gelc_long(k,i)=gelc(k,i)-ggg(k)
2653 * Loop over residues i+1 thru j-1.
2657 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2660 c 9/28/08 AL Gradient compotents will be summed only at the end
2661 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2662 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2663 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2665 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2666 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2674 ecosa=2.0D0*fac3*fac1+fac4
2677 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2678 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2680 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2681 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2683 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2684 cd & (dcosg(k),k=1,3)
2686 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
2687 & fac_shield(i)**2*fac_shield(j)**2
2690 c ghalf=0.5D0*ggg(k)
2691 c gelc(k,i)=gelc(k,i)+ghalf
2692 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2693 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2694 c gelc(k,j)=gelc(k,j)+ghalf
2695 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2696 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2700 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2703 C print *,"before22", gelc_long(1,i), gelc_long(1,j)
2706 & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2707 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
2708 & *fac_shield(i)**2*fac_shield(j)**2
2710 & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2711 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
2712 & *fac_shield(i)**2*fac_shield(j)**2
2713 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2714 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2716 C print *,"before33", gelc_long(1,i), gelc_long(1,j)
2721 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2722 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2723 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2725 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2726 C energy of a peptide unit is assumed in the form of a second-order
2727 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2728 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2729 C are computed for EVERY pair of non-contiguous peptide groups.
2732 if (j.lt.nres-1) then
2744 muij(kkk)=mu(k,i)*mu(l,j)
2745 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
2748 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
2749 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
2750 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
2751 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
2752 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
2753 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
2759 write (iout,*) 'EELEC: i',i,' j',j
2760 write (iout,*) 'j',j,' j1',j1,' j2',j2
2761 write(iout,*) 'muij',muij
2762 write (iout,*) "uy",uy(:,i)
2763 write (iout,*) "uz",uz(:,j)
2764 write (iout,*) "erij",erij
2766 ury=scalar(uy(1,i),erij)
2767 urz=scalar(uz(1,i),erij)
2768 vry=scalar(uy(1,j),erij)
2769 vrz=scalar(uz(1,j),erij)
2770 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2771 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2772 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2773 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2774 fac=dsqrt(-ael6i)*r3ij
2779 cd write (iout,'(4i5,4f10.5)')
2780 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2781 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2782 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
2783 cd & uy(:,j),uz(:,j)
2784 cd write (iout,'(4f10.5)')
2785 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2786 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2787 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2788 cd write (iout,'(9f10.5/)')
2789 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2790 C Derivatives of the elements of A in virtual-bond vectors
2792 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2794 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2795 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2796 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2797 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2798 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2799 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2800 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2801 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2802 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2803 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2804 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2805 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2807 C Compute radial contributions to the gradient
2825 C Add the contributions coming from er
2828 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2829 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2830 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2831 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2834 C Derivatives in DC(i)
2835 cgrad ghalf1=0.5d0*agg(k,1)
2836 cgrad ghalf2=0.5d0*agg(k,2)
2837 cgrad ghalf3=0.5d0*agg(k,3)
2838 cgrad ghalf4=0.5d0*agg(k,4)
2839 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2840 & -3.0d0*uryg(k,2)*vry)!+ghalf1
2841 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2842 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
2843 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2844 & -3.0d0*urzg(k,2)*vry)!+ghalf3
2845 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2846 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
2847 C Derivatives in DC(i+1)
2848 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2849 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
2850 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2851 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
2852 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2853 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
2854 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2855 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
2856 C Derivatives in DC(j)
2857 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2858 & -3.0d0*vryg(k,2)*ury)!+ghalf1
2859 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2860 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
2861 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2862 & -3.0d0*vryg(k,2)*urz)!+ghalf3
2863 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2864 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
2865 C Derivatives in DC(j+1) or DC(nres-1)
2866 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2867 & -3.0d0*vryg(k,3)*ury)
2868 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2869 & -3.0d0*vrzg(k,3)*ury)
2870 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2871 & -3.0d0*vryg(k,3)*urz)
2872 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2873 & -3.0d0*vrzg(k,3)*urz)
2874 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
2876 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
2891 aggi(k,l)=-aggi(k,l)
2892 aggi1(k,l)=-aggi1(k,l)
2893 aggj(k,l)=-aggj(k,l)
2894 aggj1(k,l)=-aggj1(k,l)
2898 if (j.lt.nres-1) then
2904 aggi(k,l)=-aggi(k,l)
2905 aggi1(k,l)=-aggi1(k,l)
2906 aggj(k,l)=-aggj(k,l)
2907 aggj1(k,l)=-aggj1(k,l)
2918 aggi(k,l)=-aggi(k,l)
2919 aggi1(k,l)=-aggi1(k,l)
2920 aggj(k,l)=-aggj(k,l)
2921 aggj1(k,l)=-aggj1(k,l)
2926 IF (wel_loc.gt.0.0d0) THEN
2927 C Contribution to the local-electrostatic energy coming from the i-j pair
2928 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2931 write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32,
2933 write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij,
2934 & " wel_loc",wel_loc
2936 if (shield_mode.eq.0) then
2943 eel_loc_ij=eel_loc_ij
2944 & *fac_shield(i)*fac_shield(j)
2945 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2946 & 'eelloc',i,j,eel_loc_ij
2947 c if (eel_loc_ij.ne.0)
2948 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
2949 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
2951 eel_loc=eel_loc+eel_loc_ij
2952 C Now derivative over eel_loc
2954 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2955 & (shield_mode.gt.0)) then
2958 do ilist=1,ishield_list(i)
2959 iresshield=shield_list(ilist,i)
2961 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2964 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2966 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2967 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2971 do ilist=1,ishield_list(j)
2972 iresshield=shield_list(ilist,j)
2974 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2977 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2979 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2980 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2987 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2988 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2989 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2990 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2991 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2992 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2993 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2994 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2999 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3000 c & ' eel_loc_ij',eel_loc_ij
3001 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
3002 C Calculate patrial derivative for theta angle
3004 geel_loc_ij=(a22*gmuij1(1)
3008 & *fac_shield(i)*fac_shield(j)
3009 c write(iout,*) "derivative over thatai"
3010 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3012 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3013 & geel_loc_ij*wel_loc
3014 c write(iout,*) "derivative over thatai-1"
3015 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3022 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3023 & geel_loc_ij*wel_loc
3024 & *fac_shield(i)*fac_shield(j)
3026 c Derivative over j residue
3027 geel_loc_ji=a22*gmuji1(1)
3031 c write(iout,*) "derivative over thataj"
3032 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3035 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3036 & geel_loc_ji*wel_loc
3037 & *fac_shield(i)*fac_shield(j)
3044 c write(iout,*) "derivative over thataj-1"
3045 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3047 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3048 & geel_loc_ji*wel_loc
3049 & *fac_shield(i)*fac_shield(j)
3051 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3053 C Partial derivatives in virtual-bond dihedral angles gamma
3055 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3056 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3057 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
3058 & *fac_shield(i)*fac_shield(j)
3060 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3061 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3062 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
3063 & *fac_shield(i)*fac_shield(j)
3064 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3066 ggg(l)=(agg(l,1)*muij(1)+
3067 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
3068 & *fac_shield(i)*fac_shield(j)
3069 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3070 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3071 cgrad ghalf=0.5d0*ggg(l)
3072 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3073 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3077 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3080 C Remaining derivatives of eello
3082 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3083 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3084 & *fac_shield(i)*fac_shield(j)
3086 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3087 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3088 & *fac_shield(i)*fac_shield(j)
3090 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3091 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3092 & *fac_shield(i)*fac_shield(j)
3094 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3095 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3096 & *fac_shield(i)*fac_shield(j)
3103 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3104 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3105 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3106 & .and. num_conti.le.maxconts) then
3107 c write (iout,*) i,j," entered corr"
3109 C Calculate the contact function. The ith column of the array JCONT will
3110 C contain the numbers of atoms that make contacts with the atom I (of numbers
3111 C greater than I). The arrays FACONT and GACONT will contain the values of
3112 C the contact function and its derivative.
3113 c r0ij=1.02D0*rpp(iteli,itelj)
3114 c r0ij=1.11D0*rpp(iteli,itelj)
3115 r0ij=2.20D0*rpp(iteli,itelj)
3116 c r0ij=1.55D0*rpp(iteli,itelj)
3117 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3118 if (fcont.gt.0.0D0) then
3119 num_conti=num_conti+1
3120 if (num_conti.gt.maxconts) then
3121 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3122 & ' will skip next contacts for this conf.'
3124 jcont_hb(num_conti,i)=j
3125 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3126 cd & " jcont_hb",jcont_hb(num_conti,i)
3127 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3128 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3129 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3131 d_cont(num_conti,i)=rij
3132 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3133 C --- Electrostatic-interaction matrix ---
3134 a_chuj(1,1,num_conti,i)=a22
3135 a_chuj(1,2,num_conti,i)=a23
3136 a_chuj(2,1,num_conti,i)=a32
3137 a_chuj(2,2,num_conti,i)=a33
3138 C --- Gradient of rij
3141 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3148 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3149 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3150 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3151 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3152 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3158 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3159 C Calculate contact energies
3161 wij=cosa-3.0D0*cosb*cosg
3164 c fac3=dsqrt(-ael6i)/r0ij**3
3165 fac3=dsqrt(-ael6i)*r3ij
3166 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3167 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3168 if (ees0tmp.gt.0) then
3169 ees0pij=dsqrt(ees0tmp)
3173 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3174 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3175 if (ees0tmp.gt.0) then
3176 ees0mij=dsqrt(ees0tmp)
3181 if (shield_mode.eq.0) then
3185 ees0plist(num_conti,i)=j
3186 C fac_shield(i)=0.4d0
3187 C fac_shield(j)=0.6d0
3189 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3190 & *fac_shield(i)*fac_shield(j)
3191 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3192 & *fac_shield(i)*fac_shield(j)
3193 C Diagnostics. Comment out or remove after debugging!
3194 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3195 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3196 c ees0m(num_conti,i)=0.0D0
3198 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3199 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3200 C Angular derivatives of the contact function
3202 ees0pij1=fac3/ees0pij
3203 ees0mij1=fac3/ees0mij
3204 fac3p=-3.0D0*fac3*rrmij
3205 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3206 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3208 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3209 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3210 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3211 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3212 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3213 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3214 ecosap=ecosa1+ecosa2
3215 ecosbp=ecosb1+ecosb2
3216 ecosgp=ecosg1+ecosg2
3217 ecosam=ecosa1-ecosa2
3218 ecosbm=ecosb1-ecosb2
3219 ecosgm=ecosg1-ecosg2
3228 facont_hb(num_conti,i)=fcont
3231 fprimcont=fprimcont/rij
3232 cd facont_hb(num_conti,i)=1.0D0
3233 C Following line is for diagnostics.
3236 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3237 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3240 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3241 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3243 gggp(1)=gggp(1)+ees0pijp*xj
3244 gggp(2)=gggp(2)+ees0pijp*yj
3245 gggp(3)=gggp(3)+ees0pijp*zj
3246 gggm(1)=gggm(1)+ees0mijp*xj
3247 gggm(2)=gggm(2)+ees0mijp*yj
3248 gggm(3)=gggm(3)+ees0mijp*zj
3249 C Derivatives due to the contact function
3250 gacont_hbr(1,num_conti,i)=fprimcont*xj
3251 gacont_hbr(2,num_conti,i)=fprimcont*yj
3252 gacont_hbr(3,num_conti,i)=fprimcont*zj
3255 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3256 c following the change of gradient-summation algorithm.
3258 cgrad ghalfp=0.5D0*gggp(k)
3259 cgrad ghalfm=0.5D0*gggm(k)
3260 gacontp_hb1(k,num_conti,i)=!ghalfp
3261 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3262 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3263 & *fac_shield(i)*fac_shield(j)
3265 gacontp_hb2(k,num_conti,i)=!ghalfp
3266 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3267 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3268 & *fac_shield(i)*fac_shield(j)
3270 gacontp_hb3(k,num_conti,i)=gggp(k)
3271 & *fac_shield(i)*fac_shield(j)
3273 gacontm_hb1(k,num_conti,i)=!ghalfm
3274 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3275 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3276 & *fac_shield(i)*fac_shield(j)
3278 gacontm_hb2(k,num_conti,i)=!ghalfm
3279 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3280 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3281 & *fac_shield(i)*fac_shield(j)
3283 gacontm_hb3(k,num_conti,i)=gggm(k)
3284 & *fac_shield(i)*fac_shield(j)
3287 C Diagnostics. Comment out or remove after debugging!
3289 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3290 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3291 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3292 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3293 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3294 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3300 endif ! num_conti.le.maxconts
3304 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3307 ghalf=0.5d0*agg(l,k)
3308 aggi(l,k)=aggi(l,k)+ghalf
3309 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3310 aggj(l,k)=aggj(l,k)+ghalf
3313 if (j.eq.nres-1 .and. i.lt.j-2) then
3316 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3322 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3325 C-----------------------------------------------------------------------------
3326 subroutine eturn3(i,eello_turn3)
3327 C Third- and fourth-order contributions from turns
3328 implicit real*8 (a-h,o-z)
3329 include 'DIMENSIONS'
3330 include 'COMMON.IOUNITS'
3331 include 'COMMON.GEO'
3332 include 'COMMON.VAR'
3333 include 'COMMON.LOCAL'
3334 include 'COMMON.CHAIN'
3335 include 'COMMON.DERIV'
3336 include 'COMMON.INTERACT'
3337 include 'COMMON.CONTACTS'
3338 include 'COMMON.TORSION'
3339 include 'COMMON.VECTORS'
3340 include 'COMMON.FFIELD'
3341 include 'COMMON.CONTROL'
3342 include 'COMMON.SHIELD'
3344 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3345 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3346 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3347 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3348 & auxgmat2(2,2),auxgmatt2(2,2)
3349 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3350 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3351 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3352 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3355 c write (iout,*) "eturn3",i,j,j1,j2
3360 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3362 C Third-order contributions
3369 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3370 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3371 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3372 c auxalary matices for theta gradient
3373 c auxalary matrix for i+1 and constant i+2
3374 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3375 c auxalary matrix for i+2 and constant i+1
3376 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3377 call transpose2(auxmat(1,1),auxmat1(1,1))
3378 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3379 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3380 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3381 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3382 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3383 if (shield_mode.eq.0) then
3390 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3391 & *fac_shield(i)*fac_shield(j)
3392 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3393 & *fac_shield(i)*fac_shield(j)
3394 if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
3398 C Derivatives in theta
3399 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3400 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3401 & *fac_shield(i)*fac_shield(j)
3402 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3403 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3404 & *fac_shield(i)*fac_shield(j)
3407 C Derivatives in shield mode
3408 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3409 & (shield_mode.gt.0)) then
3412 do ilist=1,ishield_list(i)
3413 iresshield=shield_list(ilist,i)
3415 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3417 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3419 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3420 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3424 do ilist=1,ishield_list(j)
3425 iresshield=shield_list(ilist,j)
3427 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3429 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3431 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3432 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3439 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3440 & grad_shield(k,i)*eello_t3/fac_shield(i)
3441 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3442 & grad_shield(k,j)*eello_t3/fac_shield(j)
3443 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3444 & grad_shield(k,i)*eello_t3/fac_shield(i)
3445 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3446 & grad_shield(k,j)*eello_t3/fac_shield(j)
3450 C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3451 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3452 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3453 cd & ' eello_turn3_num',4*eello_turn3_num
3454 C Derivatives in gamma(i)
3455 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3456 call transpose2(auxmat2(1,1),auxmat3(1,1))
3457 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3458 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3459 & *fac_shield(i)*fac_shield(j)
3460 C Derivatives in gamma(i+1)
3461 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3462 call transpose2(auxmat2(1,1),auxmat3(1,1))
3463 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3464 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3465 & +0.5d0*(pizda(1,1)+pizda(2,2))
3466 & *fac_shield(i)*fac_shield(j)
3467 C Cartesian derivatives
3469 c ghalf1=0.5d0*agg(l,1)
3470 c ghalf2=0.5d0*agg(l,2)
3471 c ghalf3=0.5d0*agg(l,3)
3472 c ghalf4=0.5d0*agg(l,4)
3473 a_temp(1,1)=aggi(l,1)!+ghalf1
3474 a_temp(1,2)=aggi(l,2)!+ghalf2
3475 a_temp(2,1)=aggi(l,3)!+ghalf3
3476 a_temp(2,2)=aggi(l,4)!+ghalf4
3477 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3478 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3479 & +0.5d0*(pizda(1,1)+pizda(2,2))
3480 & *fac_shield(i)*fac_shield(j)
3482 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3483 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3484 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3485 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3486 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3487 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3488 & +0.5d0*(pizda(1,1)+pizda(2,2))
3489 & *fac_shield(i)*fac_shield(j)
3490 a_temp(1,1)=aggj(l,1)!+ghalf1
3491 a_temp(1,2)=aggj(l,2)!+ghalf2
3492 a_temp(2,1)=aggj(l,3)!+ghalf3
3493 a_temp(2,2)=aggj(l,4)!+ghalf4
3494 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3495 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3496 & +0.5d0*(pizda(1,1)+pizda(2,2))
3497 & *fac_shield(i)*fac_shield(j)
3498 a_temp(1,1)=aggj1(l,1)
3499 a_temp(1,2)=aggj1(l,2)
3500 a_temp(2,1)=aggj1(l,3)
3501 a_temp(2,2)=aggj1(l,4)
3502 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3503 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3504 & +0.5d0*(pizda(1,1)+pizda(2,2))
3505 & *fac_shield(i)*fac_shield(j)
3512 C-------------------------------------------------------------------------------
3513 subroutine eturn4(i,eello_turn4)
3514 C Third- and fourth-order contributions from turns
3515 implicit real*8 (a-h,o-z)
3516 include 'DIMENSIONS'
3517 include 'COMMON.IOUNITS'
3518 include 'COMMON.GEO'
3519 include 'COMMON.VAR'
3520 include 'COMMON.LOCAL'
3521 include 'COMMON.CHAIN'
3522 include 'COMMON.DERIV'
3523 include 'COMMON.INTERACT'
3524 include 'COMMON.CONTACTS'
3525 include 'COMMON.TORSION'
3526 include 'COMMON.VECTORS'
3527 include 'COMMON.FFIELD'
3528 include 'COMMON.CONTROL'
3529 include 'COMMON.SHIELD'
3531 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3532 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3533 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3534 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3535 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3536 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3537 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3538 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3539 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3540 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3541 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3544 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3546 C Fourth-order contributions
3554 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3555 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3556 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3557 c write(iout,*)"WCHODZE W PROGRAM"
3562 iti1=itype2loc(itype(i+1))
3563 iti2=itype2loc(itype(i+2))
3564 iti3=itype2loc(itype(i+3))
3565 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3566 call transpose2(EUg(1,1,i+1),e1t(1,1))
3567 call transpose2(Eug(1,1,i+2),e2t(1,1))
3568 call transpose2(Eug(1,1,i+3),e3t(1,1))
3569 C Ematrix derivative in theta
3570 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3571 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3572 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3573 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3574 c eta1 in derivative theta
3575 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3576 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3577 c auxgvec is derivative of Ub2 so i+3 theta
3578 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3579 c auxalary matrix of E i+1
3580 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3583 s1=scalar2(b1(1,i+2),auxvec(1))
3584 c derivative of theta i+2 with constant i+3
3585 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3586 c derivative of theta i+2 with constant i+2
3587 gs32=scalar2(b1(1,i+2),auxgvec(1))
3588 c derivative of E matix in theta of i+1
3589 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3591 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3592 c ea31 in derivative theta
3593 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3594 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3595 c auxilary matrix auxgvec of Ub2 with constant E matirx
3596 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3597 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3598 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3602 s2=scalar2(b1(1,i+1),auxvec(1))
3603 c derivative of theta i+1 with constant i+3
3604 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3605 c derivative of theta i+2 with constant i+1
3606 gs21=scalar2(b1(1,i+1),auxgvec(1))
3607 c derivative of theta i+3 with constant i+1
3608 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3609 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3611 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3612 c two derivatives over diffetent matrices
3613 c gtae3e2 is derivative over i+3
3614 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3615 c ae3gte2 is derivative over i+2
3616 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3617 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3618 c three possible derivative over theta E matices
3620 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3622 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3624 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3625 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3627 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3628 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3629 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3630 if (shield_mode.eq.0) then
3637 eello_turn4=eello_turn4-(s1+s2+s3)
3638 & *fac_shield(i)*fac_shield(j)
3639 eello_t4=-(s1+s2+s3)
3640 & *fac_shield(i)*fac_shield(j)
3641 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
3642 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
3643 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
3644 C Now derivative over shield:
3645 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3646 & (shield_mode.gt.0)) then
3649 do ilist=1,ishield_list(i)
3650 iresshield=shield_list(ilist,i)
3652 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3654 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3656 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3657 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3661 do ilist=1,ishield_list(j)
3662 iresshield=shield_list(ilist,j)
3664 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3666 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3668 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3669 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3676 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3677 & grad_shield(k,i)*eello_t4/fac_shield(i)
3678 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3679 & grad_shield(k,j)*eello_t4/fac_shield(j)
3680 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3681 & grad_shield(k,i)*eello_t4/fac_shield(i)
3682 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3683 & grad_shield(k,j)*eello_t4/fac_shield(j)
3686 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3687 cd & ' eello_turn4_num',8*eello_turn4_num
3689 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3690 & -(gs13+gsE13+gsEE1)*wturn4
3691 & *fac_shield(i)*fac_shield(j)
3692 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3693 & -(gs23+gs21+gsEE2)*wturn4
3694 & *fac_shield(i)*fac_shield(j)
3696 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3697 & -(gs32+gsE31+gsEE3)*wturn4
3698 & *fac_shield(i)*fac_shield(j)
3700 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3703 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3704 & 'eturn4',i,j,-(s1+s2+s3)
3705 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3706 c & ' eello_turn4_num',8*eello_turn4_num
3707 C Derivatives in gamma(i)
3708 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3709 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3710 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3711 s1=scalar2(b1(1,i+2),auxvec(1))
3712 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3714 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3715 & *fac_shield(i)*fac_shield(j)
3716 C Derivatives in gamma(i+1)
3717 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3718 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3719 s2=scalar2(b1(1,i+1),auxvec(1))
3720 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3721 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3722 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3723 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3724 & *fac_shield(i)*fac_shield(j)
3725 C Derivatives in gamma(i+2)
3726 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3727 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3728 s1=scalar2(b1(1,i+2),auxvec(1))
3729 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3730 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3731 s2=scalar2(b1(1,i+1),auxvec(1))
3732 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3733 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3734 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3735 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3736 & *fac_shield(i)*fac_shield(j)
3738 C Cartesian derivatives
3739 C Derivatives of this turn contributions in DC(i+2)
3740 if (j.lt.nres-1) then
3742 a_temp(1,1)=agg(l,1)
3743 a_temp(1,2)=agg(l,2)
3744 a_temp(2,1)=agg(l,3)
3745 a_temp(2,2)=agg(l,4)
3746 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3747 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3748 s1=scalar2(b1(1,i+2),auxvec(1))
3749 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3750 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3751 s2=scalar2(b1(1,i+1),auxvec(1))
3752 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3753 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3754 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3756 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3757 & *fac_shield(i)*fac_shield(j)
3760 C Remaining derivatives of this turn contribution
3762 a_temp(1,1)=aggi(l,1)
3763 a_temp(1,2)=aggi(l,2)
3764 a_temp(2,1)=aggi(l,3)
3765 a_temp(2,2)=aggi(l,4)
3766 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3767 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3768 s1=scalar2(b1(1,i+2),auxvec(1))
3769 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3770 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3771 s2=scalar2(b1(1,i+1),auxvec(1))
3772 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3773 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3774 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3775 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3776 & *fac_shield(i)*fac_shield(j)
3777 a_temp(1,1)=aggi1(l,1)
3778 a_temp(1,2)=aggi1(l,2)
3779 a_temp(2,1)=aggi1(l,3)
3780 a_temp(2,2)=aggi1(l,4)
3781 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3782 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3783 s1=scalar2(b1(1,i+2),auxvec(1))
3784 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3785 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3786 s2=scalar2(b1(1,i+1),auxvec(1))
3787 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3788 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3789 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3790 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3791 & *fac_shield(i)*fac_shield(j)
3792 a_temp(1,1)=aggj(l,1)
3793 a_temp(1,2)=aggj(l,2)
3794 a_temp(2,1)=aggj(l,3)
3795 a_temp(2,2)=aggj(l,4)
3796 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3797 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3798 s1=scalar2(b1(1,i+2),auxvec(1))
3799 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3800 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3801 s2=scalar2(b1(1,i+1),auxvec(1))
3802 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3803 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3804 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3805 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3806 & *fac_shield(i)*fac_shield(j)
3807 a_temp(1,1)=aggj1(l,1)
3808 a_temp(1,2)=aggj1(l,2)
3809 a_temp(2,1)=aggj1(l,3)
3810 a_temp(2,2)=aggj1(l,4)
3811 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3812 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3813 s1=scalar2(b1(1,i+2),auxvec(1))
3814 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3815 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3816 s2=scalar2(b1(1,i+1),auxvec(1))
3817 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3818 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3819 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3820 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3821 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3822 & *fac_shield(i)*fac_shield(j)
3829 C-----------------------------------------------------------------------------
3830 subroutine vecpr(u,v,w)
3831 implicit real*8(a-h,o-z)
3832 dimension u(3),v(3),w(3)
3833 w(1)=u(2)*v(3)-u(3)*v(2)
3834 w(2)=-u(1)*v(3)+u(3)*v(1)
3835 w(3)=u(1)*v(2)-u(2)*v(1)
3838 C-----------------------------------------------------------------------------
3839 subroutine unormderiv(u,ugrad,unorm,ungrad)
3840 C This subroutine computes the derivatives of a normalized vector u, given
3841 C the derivatives computed without normalization conditions, ugrad. Returns
3844 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3845 double precision vec(3)
3846 double precision scalar
3848 c write (2,*) 'ugrad',ugrad
3851 vec(i)=scalar(ugrad(1,i),u(1))
3853 c write (2,*) 'vec',vec
3856 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3859 c write (2,*) 'ungrad',ungrad
3862 C-----------------------------------------------------------------------------
3863 subroutine escp(evdw2,evdw2_14)
3865 C This subroutine calculates the excluded-volume interaction energy between
3866 C peptide-group centers and side chains and its gradient in virtual-bond and
3867 C side-chain vectors.
3869 implicit real*8 (a-h,o-z)
3870 include 'DIMENSIONS'
3871 include 'COMMON.GEO'
3872 include 'COMMON.VAR'
3873 include 'COMMON.LOCAL'
3874 include 'COMMON.CHAIN'
3875 include 'COMMON.DERIV'
3876 include 'COMMON.INTERACT'
3877 include 'COMMON.FFIELD'
3878 include 'COMMON.IOUNITS'
3882 cd print '(a)','Enter ESCP'
3883 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3884 c & ' scal14',scal14
3885 do i=iatscp_s,iatscp_e
3886 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3888 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3889 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3890 if (iteli.eq.0) goto 1225
3891 xi=0.5D0*(c(1,i)+c(1,i+1))
3892 yi=0.5D0*(c(2,i)+c(2,i+1))
3893 zi=0.5D0*(c(3,i)+c(3,i+1))
3894 C Returning the ith atom to box
3896 if (xi.lt.0) xi=xi+boxxsize
3898 if (yi.lt.0) yi=yi+boxysize
3900 if (zi.lt.0) zi=zi+boxzsize
3901 do iint=1,nscp_gr(i)
3903 do j=iscpstart(i,iint),iscpend(i,iint)
3904 itypj=iabs(itype(j))
3905 if (itypj.eq.ntyp1) cycle
3906 C Uncomment following three lines for SC-p interactions
3910 C Uncomment following three lines for Ca-p interactions
3914 C returning the jth atom to box
3916 if (xj.lt.0) xj=xj+boxxsize
3918 if (yj.lt.0) yj=yj+boxysize
3920 if (zj.lt.0) zj=zj+boxzsize
3921 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3926 C Finding the closest jth atom
3930 xj=xj_safe+xshift*boxxsize
3931 yj=yj_safe+yshift*boxysize
3932 zj=zj_safe+zshift*boxzsize
3933 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3934 if(dist_temp.lt.dist_init) then
3944 if (subchap.eq.1) then
3953 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3954 C sss is scaling function for smoothing the cutoff gradient otherwise
3955 C the gradient would not be continuouse
3956 sss=sscale(1.0d0/(dsqrt(rrij)))
3957 if (sss.le.0.0d0) cycle
3958 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3960 e1=fac*fac*aad(itypj,iteli)
3961 e2=fac*bad(itypj,iteli)
3962 if (iabs(j-i) .le. 2) then
3965 evdw2_14=evdw2_14+(e1+e2)*sss
3968 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3969 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3970 c & bad(itypj,iteli)
3971 evdw2=evdw2+evdwij*sss
3974 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3976 fac=-(evdwij+e1)*rrij*sss
3977 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3982 cd write (iout,*) 'j<i'
3983 C Uncomment following three lines for SC-p interactions
3985 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3988 cd write (iout,*) 'j>i'
3991 C Uncomment following line for SC-p interactions
3992 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3996 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4000 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4001 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4004 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4014 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4015 gradx_scp(j,i)=expon*gradx_scp(j,i)
4018 C******************************************************************************
4022 C To save time the factor EXPON has been extracted from ALL components
4023 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4026 C******************************************************************************
4029 C--------------------------------------------------------------------------
4030 subroutine edis(ehpb)
4032 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4034 implicit real*8 (a-h,o-z)
4035 include 'DIMENSIONS'
4036 include 'COMMON.SBRIDGE'
4037 include 'COMMON.CHAIN'
4038 include 'COMMON.DERIV'
4039 include 'COMMON.VAR'
4040 include 'COMMON.INTERACT'
4041 include 'COMMON.CONTROL'
4042 include 'COMMON.IOUNITS'
4043 dimension ggg(3),ggg_peak(3,100)
4046 C write (iout,*) ,"link_end",link_end,constr_dist
4047 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4048 c write(iout,*)'link_start=',link_start,' link_end=',link_end,
4049 c & " constr_dist",constr_dist
4050 if (link_end.eq.0.and.link_end_peak.eq.0) return
4051 do i=link_start_peak,link_end_peak
4053 c print *,"i",i," link_end_peak",link_end_peak," ipeak",
4054 c & ipeak(1,i),ipeak(2,i)
4055 do ip=ipeak(1,i),ipeak(2,i)
4060 C iii and jjj point to the residues for which the distance is assigned.
4061 if (ii.gt.nres) then
4068 aux=rlornmr1(dd,dhpb_peak(ip),dhpb1_peak(ip),forcon_peak(ip))
4069 aux=dexp(-scal_peak*aux)
4070 ehpb_peak=ehpb_peak+aux
4071 fac=rlornmr1prim(dd,dhpb_peak(ip),dhpb1_peak(ip),
4072 & forcon_peak(ip))*aux/dd
4074 ggg_peak(j,iip)=fac*(c(j,jj)-c(j,ii))
4076 if (energy_dec) write (iout,'(a6,3i5,6f10.3,i5)')
4077 & "edisL",i,ii,jj,dd,dhpb_peak(ip),dhpb1_peak(ip),
4078 & forcon_peak(ip),fordepth_peak(ip),ehpb_peak
4080 c write (iout,*) "ehpb_peak",ehpb_peak," scal_peak",scal_peak
4081 ehpb=ehpb-fordepth_peak(ipeak(1,i))*dlog(ehpb_peak)/scal_peak
4082 do ip=ipeak(1,i),ipeak(2,i)
4085 ggg(j)=ggg_peak(j,iip)/ehpb_peak
4089 C iii and jjj point to the residues for which the distance is assigned.
4090 if (ii.gt.nres) then
4099 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4100 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4104 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4105 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4109 do i=link_start,link_end
4110 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4111 C CA-CA distance used in regularization of structure.
4114 C iii and jjj point to the residues for which the distance is assigned.
4115 if (ii.gt.nres) then
4122 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4123 c & dhpb(i),dhpb1(i),forcon(i)
4124 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4125 C distance and angle dependent SS bond potential.
4126 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4127 C & iabs(itype(jjj)).eq.1) then
4128 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4129 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4130 if (.not.dyn_ss .and. i.le.nss) then
4131 C 15/02/13 CC dynamic SSbond - additional check
4132 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4133 & iabs(itype(jjj)).eq.1) then
4134 call ssbond_ene(iii,jjj,eij)
4137 cd write (iout,*) "eij",eij
4138 cd & ' waga=',waga,' fac=',fac
4139 ! else if (ii.gt.nres .and. jj.gt.nres) then
4141 C Calculate the distance between the two points and its difference from the
4144 if (irestr_type(i).eq.11) then
4145 ehpb=ehpb+fordepth(i)!**4.0d0
4146 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4147 fac=fordepth(i)!**4.0d0
4148 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4149 if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
4150 & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4151 & ehpb,irestr_type(i)
4152 else if (irestr_type(i).eq.10) then
4153 c AL 6//19/2018 cross-link restraints
4154 xdis = 0.5d0*(dd/forcon(i))**2
4155 expdis = dexp(-xdis)
4156 c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
4157 aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
4158 c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
4159 c & " wboltzd",wboltzd
4160 ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
4161 c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
4162 fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
4163 & *expdis/(aux*forcon(i)**2)
4164 if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
4165 & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
4166 & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
4167 else if (irestr_type(i).eq.2) then
4168 c Quartic restraints
4169 ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4170 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4171 & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4172 & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
4173 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4175 c Quadratic restraints
4177 C Get the force constant corresponding to this distance.
4179 C Calculate the contribution to energy.
4180 ehpb=ehpb+0.5d0*waga*rdis*rdis
4181 if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
4182 & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
4183 & 0.5d0*waga*rdis*rdis,irestr_type(i)
4185 C Evaluate gradient.
4189 c Calculate Cartesian gradient
4191 ggg(j)=fac*(c(j,jj)-c(j,ii))
4193 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4194 C If this is a SC-SC distance, we need to calculate the contributions to the
4195 C Cartesian gradient in the SC vectors (ghpbx).
4198 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4199 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4203 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4204 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4210 C--------------------------------------------------------------------------
4211 subroutine ssbond_ene(i,j,eij)
4213 C Calculate the distance and angle dependent SS-bond potential energy
4214 C using a free-energy function derived based on RHF/6-31G** ab initio
4215 C calculations of diethyl disulfide.
4217 C A. Liwo and U. Kozlowska, 11/24/03
4219 implicit real*8 (a-h,o-z)
4220 include 'DIMENSIONS'
4221 include 'COMMON.SBRIDGE'
4222 include 'COMMON.CHAIN'
4223 include 'COMMON.DERIV'
4224 include 'COMMON.LOCAL'
4225 include 'COMMON.INTERACT'
4226 include 'COMMON.VAR'
4227 include 'COMMON.IOUNITS'
4228 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4229 itypi=iabs(itype(i))
4233 dxi=dc_norm(1,nres+i)
4234 dyi=dc_norm(2,nres+i)
4235 dzi=dc_norm(3,nres+i)
4236 dsci_inv=dsc_inv(itypi)
4237 itypj=iabs(itype(j))
4238 dscj_inv=dsc_inv(itypj)
4242 dxj=dc_norm(1,nres+j)
4243 dyj=dc_norm(2,nres+j)
4244 dzj=dc_norm(3,nres+j)
4245 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4250 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4251 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4252 om12=dxi*dxj+dyi*dyj+dzi*dzj
4254 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4255 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4261 deltat12=om2-om1+2.0d0
4263 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4264 & +akct*deltad*deltat12
4265 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4266 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4267 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4268 c & " deltat12",deltat12," eij",eij
4269 ed=2*akcm*deltad+akct*deltat12
4271 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4272 eom1=-2*akth*deltat1-pom1-om2*pom2
4273 eom2= 2*akth*deltat2+pom1-om1*pom2
4276 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4279 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4280 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4281 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4282 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4285 C Calculate the components of the gradient in DC and X
4289 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4294 C--------------------------------------------------------------------------
4295 subroutine ebond(estr)
4297 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4299 implicit real*8 (a-h,o-z)
4300 include 'DIMENSIONS'
4301 include 'COMMON.LOCAL'
4302 include 'COMMON.GEO'
4303 include 'COMMON.INTERACT'
4304 include 'COMMON.DERIV'
4305 include 'COMMON.VAR'
4306 include 'COMMON.CHAIN'
4307 include 'COMMON.IOUNITS'
4308 include 'COMMON.NAMES'
4309 include 'COMMON.FFIELD'
4310 include 'COMMON.CONTROL'
4311 double precision u(3),ud(3)
4314 c write (iout,*) "distchainmax",distchainmax
4316 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4317 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4319 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4320 C & *dc(j,i-1)/vbld(i)
4322 C if (energy_dec) write(iout,*)
4323 C & "estr1",i,vbld(i),distchainmax,
4324 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4326 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4327 diff = vbld(i)-vbldpDUM
4328 C write(iout,*) i,diff
4330 diff = vbld(i)-vbldp0
4331 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4335 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4338 C write (iout,'(a7,i5,4f7.3)')
4339 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4341 estr=0.5d0*AKP*estr+estr1
4343 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4347 if (iti.ne.10 .and. iti.ne.ntyp1) then
4350 diff=vbld(i+nres)-vbldsc0(1,iti)
4351 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4352 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4353 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4355 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4359 diff=vbld(i+nres)-vbldsc0(j,iti)
4360 ud(j)=aksc(j,iti)*diff
4361 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4375 uprod2=uprod2*u(k)*u(k)
4379 usumsqder=usumsqder+ud(j)*uprod2
4381 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4382 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4383 estr=estr+uprod/usum
4385 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4393 C--------------------------------------------------------------------------
4394 subroutine ebend(etheta,ethetacnstr)
4396 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4397 C angles gamma and its derivatives in consecutive thetas and gammas.
4399 implicit real*8 (a-h,o-z)
4400 include 'DIMENSIONS'
4401 include 'COMMON.LOCAL'
4402 include 'COMMON.GEO'
4403 include 'COMMON.INTERACT'
4404 include 'COMMON.DERIV'
4405 include 'COMMON.VAR'
4406 include 'COMMON.CHAIN'
4407 include 'COMMON.IOUNITS'
4408 include 'COMMON.NAMES'
4409 include 'COMMON.FFIELD'
4410 include 'COMMON.TORCNSTR'
4411 common /calcthet/ term1,term2,termm,diffak,ratak,
4412 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4413 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4414 double precision y(2),z(2)
4416 c time11=dexp(-2*time)
4419 c write (iout,*) "nres",nres
4420 c write (*,'(a,i2)') 'EBEND ICG=',icg
4421 c write (iout,*) ithet_start,ithet_end
4422 do i=ithet_start,ithet_end
4423 C if (itype(i-1).eq.ntyp1) cycle
4425 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4426 & .or.itype(i).eq.ntyp1) cycle
4427 C Zero the energy function and its derivative at 0 or pi.
4428 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4430 ichir1=isign(1,itype(i-2))
4431 ichir2=isign(1,itype(i))
4432 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4433 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4434 if (itype(i-1).eq.10) then
4435 itype1=isign(10,itype(i-2))
4436 ichir11=isign(1,itype(i-2))
4437 ichir12=isign(1,itype(i-2))
4438 itype2=isign(10,itype(i))
4439 ichir21=isign(1,itype(i))
4440 ichir22=isign(1,itype(i))
4447 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4451 c call proc_proc(phii,icrc)
4452 if (icrc.eq.1) phii=150.0
4463 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4467 c call proc_proc(phii1,icrc)
4468 if (icrc.eq.1) phii1=150.0
4480 C Calculate the "mean" value of theta from the part of the distribution
4481 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4482 C In following comments this theta will be referred to as t_c.
4483 thet_pred_mean=0.0d0
4485 athetk=athet(k,it,ichir1,ichir2)
4486 bthetk=bthet(k,it,ichir1,ichir2)
4488 athetk=athet(k,itype1,ichir11,ichir12)
4489 bthetk=bthet(k,itype2,ichir21,ichir22)
4491 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4493 c write (iout,*) "thet_pred_mean",thet_pred_mean
4494 dthett=thet_pred_mean*ssd
4495 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4496 c write (iout,*) "thet_pred_mean",thet_pred_mean
4497 C Derivatives of the "mean" values in gamma1 and gamma2.
4498 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4499 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4500 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4501 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4503 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4504 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4505 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4506 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4508 if (theta(i).gt.pi-delta) then
4509 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4511 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4512 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4513 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4515 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4517 else if (theta(i).lt.delta) then
4518 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4519 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4520 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4522 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4523 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4526 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4529 etheta=etheta+ethetai
4530 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4531 c & 'ebend',i,ethetai,theta(i),itype(i)
4532 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4533 c & rad2deg*phii,rad2deg*phii1,ethetai
4534 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4535 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4536 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4540 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4541 do i=1,ntheta_constr
4542 itheta=itheta_constr(i)
4543 thetiii=theta(itheta)
4544 difi=pinorm(thetiii-theta_constr0(i))
4545 if (difi.gt.theta_drange(i)) then
4546 difi=difi-theta_drange(i)
4547 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4548 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4549 & +for_thet_constr(i)*difi**3
4550 else if (difi.lt.-drange(i)) then
4552 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4553 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4554 & +for_thet_constr(i)*difi**3
4558 C if (energy_dec) then
4559 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4560 C & i,itheta,rad2deg*thetiii,
4561 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4562 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4563 C & gloc(itheta+nphi-2,icg)
4566 C Ufff.... We've done all this!!!
4569 C---------------------------------------------------------------------------
4570 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4572 implicit real*8 (a-h,o-z)
4573 include 'DIMENSIONS'
4574 include 'COMMON.LOCAL'
4575 include 'COMMON.IOUNITS'
4576 common /calcthet/ term1,term2,termm,diffak,ratak,
4577 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4578 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4579 C Calculate the contributions to both Gaussian lobes.
4580 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4581 C The "polynomial part" of the "standard deviation" of this part of
4585 sig=sig*thet_pred_mean+polthet(j,it)
4587 C Derivative of the "interior part" of the "standard deviation of the"
4588 C gamma-dependent Gaussian lobe in t_c.
4589 sigtc=3*polthet(3,it)
4591 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4594 C Set the parameters of both Gaussian lobes of the distribution.
4595 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4596 fac=sig*sig+sigc0(it)
4599 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4600 sigsqtc=-4.0D0*sigcsq*sigtc
4601 c print *,i,sig,sigtc,sigsqtc
4602 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4603 sigtc=-sigtc/(fac*fac)
4604 C Following variable is sigma(t_c)**(-2)
4605 sigcsq=sigcsq*sigcsq
4607 sig0inv=1.0D0/sig0i**2
4608 delthec=thetai-thet_pred_mean
4609 delthe0=thetai-theta0i
4610 term1=-0.5D0*sigcsq*delthec*delthec
4611 term2=-0.5D0*sig0inv*delthe0*delthe0
4612 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4613 C NaNs in taking the logarithm. We extract the largest exponent which is added
4614 C to the energy (this being the log of the distribution) at the end of energy
4615 C term evaluation for this virtual-bond angle.
4616 if (term1.gt.term2) then
4618 term2=dexp(term2-termm)
4622 term1=dexp(term1-termm)
4625 C The ratio between the gamma-independent and gamma-dependent lobes of
4626 C the distribution is a Gaussian function of thet_pred_mean too.
4627 diffak=gthet(2,it)-thet_pred_mean
4628 ratak=diffak/gthet(3,it)**2
4629 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4630 C Let's differentiate it in thet_pred_mean NOW.
4632 C Now put together the distribution terms to make complete distribution.
4633 termexp=term1+ak*term2
4634 termpre=sigc+ak*sig0i
4635 C Contribution of the bending energy from this theta is just the -log of
4636 C the sum of the contributions from the two lobes and the pre-exponential
4637 C factor. Simple enough, isn't it?
4638 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4639 C NOW the derivatives!!!
4640 C 6/6/97 Take into account the deformation.
4641 E_theta=(delthec*sigcsq*term1
4642 & +ak*delthe0*sig0inv*term2)/termexp
4643 E_tc=((sigtc+aktc*sig0i)/termpre
4644 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4645 & aktc*term2)/termexp)
4648 c-----------------------------------------------------------------------------
4649 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4650 implicit real*8 (a-h,o-z)
4651 include 'DIMENSIONS'
4652 include 'COMMON.LOCAL'
4653 include 'COMMON.IOUNITS'
4654 common /calcthet/ term1,term2,termm,diffak,ratak,
4655 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4656 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4657 delthec=thetai-thet_pred_mean
4658 delthe0=thetai-theta0i
4659 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4660 t3 = thetai-thet_pred_mean
4664 t14 = t12+t6*sigsqtc
4666 t21 = thetai-theta0i
4672 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4673 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4674 & *(-t12*t9-ak*sig0inv*t27)
4678 C--------------------------------------------------------------------------
4679 subroutine ebend(etheta)
4681 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4682 C angles gamma and its derivatives in consecutive thetas and gammas.
4683 C ab initio-derived potentials from
4684 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4686 implicit real*8 (a-h,o-z)
4687 include 'DIMENSIONS'
4688 include 'COMMON.LOCAL'
4689 include 'COMMON.GEO'
4690 include 'COMMON.INTERACT'
4691 include 'COMMON.DERIV'
4692 include 'COMMON.VAR'
4693 include 'COMMON.CHAIN'
4694 include 'COMMON.IOUNITS'
4695 include 'COMMON.NAMES'
4696 include 'COMMON.FFIELD'
4697 include 'COMMON.CONTROL'
4698 include 'COMMON.TORCNSTR'
4699 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4700 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4701 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4702 & sinph1ph2(maxdouble,maxdouble)
4703 logical lprn /.false./, lprn1 /.false./
4705 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4706 do i=ithet_start,ithet_end
4708 C if (itype(i-1).eq.ntyp1) cycle
4710 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4711 & .or.itype(i).eq.ntyp1) cycle
4712 if (iabs(itype(i+1)).eq.20) iblock=2
4713 if (iabs(itype(i+1)).ne.20) iblock=1
4717 theti2=0.5d0*theta(i)
4718 ityp2=ithetyp((itype(i-1)))
4720 coskt(k)=dcos(k*theti2)
4721 sinkt(k)=dsin(k*theti2)
4731 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4734 if (phii.ne.phii) phii=150.0
4738 ityp1=ithetyp((itype(i-2)))
4740 cosph1(k)=dcos(k*phii)
4741 sinph1(k)=dsin(k*phii)
4747 ityp1=ithetyp((itype(i-2)))
4753 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4756 if (phii1.ne.phii1) phii1=150.0
4761 ityp3=ithetyp((itype(i)))
4763 cosph2(k)=dcos(k*phii1)
4764 sinph2(k)=dsin(k*phii1)
4769 ityp3=ithetyp((itype(i)))
4775 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4776 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4778 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4781 ccl=cosph1(l)*cosph2(k-l)
4782 ssl=sinph1(l)*sinph2(k-l)
4783 scl=sinph1(l)*cosph2(k-l)
4784 csl=cosph1(l)*sinph2(k-l)
4785 cosph1ph2(l,k)=ccl-ssl
4786 cosph1ph2(k,l)=ccl+ssl
4787 sinph1ph2(l,k)=scl+csl
4788 sinph1ph2(k,l)=scl-csl
4792 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4793 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4794 write (iout,*) "coskt and sinkt"
4796 write (iout,*) k,coskt(k),sinkt(k)
4800 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4801 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4804 & write (iout,*) "k",k,"
4805 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4806 & " ethetai",ethetai
4809 write (iout,*) "cosph and sinph"
4811 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4813 write (iout,*) "cosph1ph2 and sinph2ph2"
4816 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4817 & sinph1ph2(l,k),sinph1ph2(k,l)
4820 write(iout,*) "ethetai",ethetai
4824 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4825 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4826 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4827 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4828 ethetai=ethetai+sinkt(m)*aux
4829 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4830 dephii=dephii+k*sinkt(m)*(
4831 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4832 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4833 dephii1=dephii1+k*sinkt(m)*(
4834 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4835 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4837 & write (iout,*) "m",m," k",k," bbthet",
4838 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4839 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4840 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4841 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4845 & write(iout,*) "ethetai",ethetai
4849 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4850 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4851 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4852 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4853 ethetai=ethetai+sinkt(m)*aux
4854 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4855 dephii=dephii+l*sinkt(m)*(
4856 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4857 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4858 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4859 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4860 dephii1=dephii1+(k-l)*sinkt(m)*(
4861 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4862 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4863 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4864 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4866 write (iout,*) "m",m," k",k," l",l," ffthet",
4867 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4868 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4869 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4870 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4871 & " ethetai",ethetai
4872 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4873 & cosph1ph2(k,l)*sinkt(m),
4874 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4880 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4881 & i,theta(i)*rad2deg,phii*rad2deg,
4882 & phii1*rad2deg,ethetai
4883 etheta=etheta+ethetai
4884 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4885 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4886 c gloc(nphi+i-2,icg)=wang*dethetai
4887 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4893 c-----------------------------------------------------------------------------
4894 subroutine esc(escloc)
4895 C Calculate the local energy of a side chain and its derivatives in the
4896 C corresponding virtual-bond valence angles THETA and the spherical angles
4898 implicit real*8 (a-h,o-z)
4899 include 'DIMENSIONS'
4900 include 'COMMON.GEO'
4901 include 'COMMON.LOCAL'
4902 include 'COMMON.VAR'
4903 include 'COMMON.INTERACT'
4904 include 'COMMON.DERIV'
4905 include 'COMMON.CHAIN'
4906 include 'COMMON.IOUNITS'
4907 include 'COMMON.NAMES'
4908 include 'COMMON.FFIELD'
4909 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4910 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4911 common /sccalc/ time11,time12,time112,theti,it,nlobit
4914 C write (iout,*) 'ESC'
4915 do i=loc_start,loc_end
4917 if (it.eq.ntyp1) cycle
4918 if (it.eq.10) goto 1
4919 nlobit=nlob(iabs(it))
4920 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4921 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4922 theti=theta(i+1)-pipol
4926 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4928 if (x(2).gt.pi-delta) then
4932 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4934 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4935 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4937 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4938 & ddersc0(1),dersc(1))
4939 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4940 & ddersc0(3),dersc(3))
4942 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4944 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4945 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4946 & dersc0(2),esclocbi,dersc02)
4947 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4949 call splinthet(x(2),0.5d0*delta,ss,ssd)
4954 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4956 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4957 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4959 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4961 c write (iout,*) escloci
4962 else if (x(2).lt.delta) then
4966 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4968 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4969 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4971 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4972 & ddersc0(1),dersc(1))
4973 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4974 & ddersc0(3),dersc(3))
4976 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4978 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4979 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4980 & dersc0(2),esclocbi,dersc02)
4981 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4986 call splinthet(x(2),0.5d0*delta,ss,ssd)
4988 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4990 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4991 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4993 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4994 C write (iout,*) 'i=',i, escloci
4996 call enesc(x,escloci,dersc,ddummy,.false.)
4999 escloc=escloc+escloci
5000 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5001 write (iout,'(a6,i5,0pf7.3)')
5002 & 'escloc',i,escloci
5004 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5006 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5007 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5012 C---------------------------------------------------------------------------
5013 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5014 implicit real*8 (a-h,o-z)
5015 include 'DIMENSIONS'
5016 include 'COMMON.GEO'
5017 include 'COMMON.LOCAL'
5018 include 'COMMON.IOUNITS'
5019 common /sccalc/ time11,time12,time112,theti,it,nlobit
5020 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5021 double precision contr(maxlob,-1:1)
5023 c write (iout,*) 'it=',it,' nlobit=',nlobit
5027 if (mixed) ddersc(j)=0.0d0
5031 C Because of periodicity of the dependence of the SC energy in omega we have
5032 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5033 C To avoid underflows, first compute & store the exponents.
5041 z(k)=x(k)-censc(k,j,it)
5046 Axk=Axk+gaussc(l,k,j,it)*z(l)
5052 expfac=expfac+Ax(k,j,iii)*z(k)
5060 C As in the case of ebend, we want to avoid underflows in exponentiation and
5061 C subsequent NaNs and INFs in energy calculation.
5062 C Find the largest exponent
5066 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5070 cd print *,'it=',it,' emin=',emin
5072 C Compute the contribution to SC energy and derivatives
5076 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5077 cd print *,'j=',j,' expfac=',expfac
5078 escloc_i=escloc_i+expfac
5080 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5084 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5085 & +gaussc(k,2,j,it))*expfac
5092 dersc(1)=dersc(1)/cos(theti)**2
5093 ddersc(1)=ddersc(1)/cos(theti)**2
5096 escloci=-(dlog(escloc_i)-emin)
5098 dersc(j)=dersc(j)/escloc_i
5102 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5107 C------------------------------------------------------------------------------
5108 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5109 implicit real*8 (a-h,o-z)
5110 include 'DIMENSIONS'
5111 include 'COMMON.GEO'
5112 include 'COMMON.LOCAL'
5113 include 'COMMON.IOUNITS'
5114 common /sccalc/ time11,time12,time112,theti,it,nlobit
5115 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5116 double precision contr(maxlob)
5127 z(k)=x(k)-censc(k,j,it)
5133 Axk=Axk+gaussc(l,k,j,it)*z(l)
5139 expfac=expfac+Ax(k,j)*z(k)
5144 C As in the case of ebend, we want to avoid underflows in exponentiation and
5145 C subsequent NaNs and INFs in energy calculation.
5146 C Find the largest exponent
5149 if (emin.gt.contr(j)) emin=contr(j)
5153 C Compute the contribution to SC energy and derivatives
5157 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5158 escloc_i=escloc_i+expfac
5160 dersc(k)=dersc(k)+Ax(k,j)*expfac
5162 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5163 & +gaussc(1,2,j,it))*expfac
5167 dersc(1)=dersc(1)/cos(theti)**2
5168 dersc12=dersc12/cos(theti)**2
5169 escloci=-(dlog(escloc_i)-emin)
5171 dersc(j)=dersc(j)/escloc_i
5173 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5177 c----------------------------------------------------------------------------------
5178 subroutine esc(escloc)
5179 C Calculate the local energy of a side chain and its derivatives in the
5180 C corresponding virtual-bond valence angles THETA and the spherical angles
5181 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5182 C added by Urszula Kozlowska. 07/11/2007
5184 implicit real*8 (a-h,o-z)
5185 include 'DIMENSIONS'
5186 include 'COMMON.GEO'
5187 include 'COMMON.LOCAL'
5188 include 'COMMON.VAR'
5189 include 'COMMON.SCROT'
5190 include 'COMMON.INTERACT'
5191 include 'COMMON.DERIV'
5192 include 'COMMON.CHAIN'
5193 include 'COMMON.IOUNITS'
5194 include 'COMMON.NAMES'
5195 include 'COMMON.FFIELD'
5196 include 'COMMON.CONTROL'
5197 include 'COMMON.VECTORS'
5198 double precision x_prime(3),y_prime(3),z_prime(3)
5199 & , sumene,dsc_i,dp2_i,x(65),
5200 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5201 & de_dxx,de_dyy,de_dzz,de_dt
5202 double precision s1_t,s1_6_t,s2_t,s2_6_t
5204 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5205 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5206 & dt_dCi(3),dt_dCi1(3)
5207 common /sccalc/ time11,time12,time112,theti,it,nlobit
5210 do i=loc_start,loc_end
5211 if (itype(i).eq.ntyp1) cycle
5212 costtab(i+1) =dcos(theta(i+1))
5213 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5214 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5215 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5216 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5217 cosfac=dsqrt(cosfac2)
5218 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5219 sinfac=dsqrt(sinfac2)
5221 if (it.eq.10) goto 1
5223 C Compute the axes of tghe local cartesian coordinates system; store in
5224 c x_prime, y_prime and z_prime
5231 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5232 C & dc_norm(3,i+nres)
5234 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5235 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5238 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5241 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5242 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5243 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5244 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5245 c & " xy",scalar(x_prime(1),y_prime(1)),
5246 c & " xz",scalar(x_prime(1),z_prime(1)),
5247 c & " yy",scalar(y_prime(1),y_prime(1)),
5248 c & " yz",scalar(y_prime(1),z_prime(1)),
5249 c & " zz",scalar(z_prime(1),z_prime(1))
5251 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5252 C to local coordinate system. Store in xx, yy, zz.
5258 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5259 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5260 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5267 C Compute the energy of the ith side cbain
5269 c write (2,*) "xx",xx," yy",yy," zz",zz
5272 x(j) = sc_parmin(j,it)
5275 Cc diagnostics - remove later
5277 yy1 = dsin(alph(2))*dcos(omeg(2))
5278 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5279 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5280 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5282 C," --- ", xx_w,yy_w,zz_w
5285 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5286 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5288 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5289 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5291 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5292 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5293 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5294 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5295 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5297 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5298 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5299 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5300 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5301 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5303 dsc_i = 0.743d0+x(61)
5305 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5306 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5307 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5308 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5309 s1=(1+x(63))/(0.1d0 + dscp1)
5310 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5311 s2=(1+x(65))/(0.1d0 + dscp2)
5312 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5313 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5314 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5315 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5317 c & dscp1,dscp2,sumene
5318 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5319 escloc = escloc + sumene
5320 c write (2,*) "escloc",escloc
5321 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5323 if (.not. calc_grad) goto 1
5326 C This section to check the numerical derivatives of the energy of ith side
5327 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5328 C #define DEBUG in the code to turn it on.
5330 write (2,*) "sumene =",sumene
5334 write (2,*) xx,yy,zz
5335 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5336 de_dxx_num=(sumenep-sumene)/aincr
5338 write (2,*) "xx+ sumene from enesc=",sumenep
5341 write (2,*) xx,yy,zz
5342 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5343 de_dyy_num=(sumenep-sumene)/aincr
5345 write (2,*) "yy+ sumene from enesc=",sumenep
5348 write (2,*) xx,yy,zz
5349 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5350 de_dzz_num=(sumenep-sumene)/aincr
5352 write (2,*) "zz+ sumene from enesc=",sumenep
5353 costsave=cost2tab(i+1)
5354 sintsave=sint2tab(i+1)
5355 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5356 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5357 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5358 de_dt_num=(sumenep-sumene)/aincr
5359 write (2,*) " t+ sumene from enesc=",sumenep
5360 cost2tab(i+1)=costsave
5361 sint2tab(i+1)=sintsave
5362 C End of diagnostics section.
5365 C Compute the gradient of esc
5367 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5368 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5369 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5370 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5371 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5372 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5373 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5374 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5375 pom1=(sumene3*sint2tab(i+1)+sumene1)
5376 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5377 pom2=(sumene4*cost2tab(i+1)+sumene2)
5378 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5379 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5380 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5381 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5383 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5384 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5385 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5387 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5388 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5389 & +(pom1+pom2)*pom_dx
5391 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5394 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5395 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5396 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5398 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5399 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5400 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5401 & +x(59)*zz**2 +x(60)*xx*zz
5402 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5403 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5404 & +(pom1-pom2)*pom_dy
5406 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5409 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5410 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5411 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5412 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5413 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5414 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5415 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5416 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5418 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5421 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5422 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5423 & +pom1*pom_dt1+pom2*pom_dt2
5425 write(2,*), "de_dt = ", de_dt,de_dt_num
5429 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5430 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5431 cosfac2xx=cosfac2*xx
5432 sinfac2yy=sinfac2*yy
5434 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5436 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5438 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5439 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5440 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5441 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5442 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5443 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5444 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5445 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5446 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5447 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5451 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5452 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5453 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5454 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5457 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5458 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5459 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5461 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5462 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5466 dXX_Ctab(k,i)=dXX_Ci(k)
5467 dXX_C1tab(k,i)=dXX_Ci1(k)
5468 dYY_Ctab(k,i)=dYY_Ci(k)
5469 dYY_C1tab(k,i)=dYY_Ci1(k)
5470 dZZ_Ctab(k,i)=dZZ_Ci(k)
5471 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5472 dXX_XYZtab(k,i)=dXX_XYZ(k)
5473 dYY_XYZtab(k,i)=dYY_XYZ(k)
5474 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5478 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5479 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5480 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5481 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5482 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5484 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5485 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5486 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5487 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5488 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5489 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5490 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5491 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5493 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5494 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5496 C to check gradient call subroutine check_grad
5503 c------------------------------------------------------------------------------
5504 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5506 C This procedure calculates two-body contact function g(rij) and its derivative:
5509 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5512 C where x=(rij-r0ij)/delta
5514 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5517 double precision rij,r0ij,eps0ij,fcont,fprimcont
5518 double precision x,x2,x4,delta
5522 if (x.lt.-1.0D0) then
5525 else if (x.le.1.0D0) then
5528 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5529 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5536 c------------------------------------------------------------------------------
5537 subroutine splinthet(theti,delta,ss,ssder)
5538 implicit real*8 (a-h,o-z)
5539 include 'DIMENSIONS'
5540 include 'COMMON.VAR'
5541 include 'COMMON.GEO'
5544 if (theti.gt.pipol) then
5545 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5547 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5552 c------------------------------------------------------------------------------
5553 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5555 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5556 double precision ksi,ksi2,ksi3,a1,a2,a3
5557 a1=fprim0*delta/(f1-f0)
5563 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5564 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5567 c------------------------------------------------------------------------------
5568 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5570 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5571 double precision ksi,ksi2,ksi3,a1,a2,a3
5576 a2=3*(f1x-f0x)-2*fprim0x*delta
5577 a3=fprim0x*delta-2*(f1x-f0x)
5578 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5581 C-----------------------------------------------------------------------------
5583 C-----------------------------------------------------------------------------
5584 subroutine etor(etors,fact)
5585 implicit real*8 (a-h,o-z)
5586 include 'DIMENSIONS'
5587 include 'COMMON.VAR'
5588 include 'COMMON.GEO'
5589 include 'COMMON.LOCAL'
5590 include 'COMMON.TORSION'
5591 include 'COMMON.INTERACT'
5592 include 'COMMON.DERIV'
5593 include 'COMMON.CHAIN'
5594 include 'COMMON.NAMES'
5595 include 'COMMON.IOUNITS'
5596 include 'COMMON.FFIELD'
5597 include 'COMMON.TORCNSTR'
5599 C Set lprn=.true. for debugging
5603 do i=iphi_start,iphi_end
5604 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5605 & .or. itype(i).eq.ntyp1) cycle
5606 itori=itortyp(itype(i-2))
5607 itori1=itortyp(itype(i-1))
5610 C Proline-Proline pair is a special case...
5611 if (itori.eq.3 .and. itori1.eq.3) then
5612 if (phii.gt.-dwapi3) then
5614 fac=1.0D0/(1.0D0-cosphi)
5615 etorsi=v1(1,3,3)*fac
5616 etorsi=etorsi+etorsi
5617 etors=etors+etorsi-v1(1,3,3)
5618 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5621 v1ij=v1(j+1,itori,itori1)
5622 v2ij=v2(j+1,itori,itori1)
5625 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5626 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5630 v1ij=v1(j,itori,itori1)
5631 v2ij=v2(j,itori,itori1)
5634 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5635 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5639 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5640 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5641 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5642 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5643 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5647 c------------------------------------------------------------------------------
5649 subroutine etor(etors,fact)
5650 implicit real*8 (a-h,o-z)
5651 include 'DIMENSIONS'
5652 include 'COMMON.VAR'
5653 include 'COMMON.GEO'
5654 include 'COMMON.LOCAL'
5655 include 'COMMON.TORSION'
5656 include 'COMMON.INTERACT'
5657 include 'COMMON.DERIV'
5658 include 'COMMON.CHAIN'
5659 include 'COMMON.NAMES'
5660 include 'COMMON.IOUNITS'
5661 include 'COMMON.FFIELD'
5662 include 'COMMON.TORCNSTR'
5664 C Set lprn=.true. for debugging
5668 do i=iphi_start,iphi_end
5670 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5671 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5672 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5673 C & .or. itype(i).eq.ntyp1) cycle
5674 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5675 if (iabs(itype(i)).eq.20) then
5680 itori=itortyp(itype(i-2))
5681 itori1=itortyp(itype(i-1))
5684 C Regular cosine and sine terms
5685 do j=1,nterm(itori,itori1,iblock)
5686 v1ij=v1(j,itori,itori1,iblock)
5687 v2ij=v2(j,itori,itori1,iblock)
5690 etors=etors+v1ij*cosphi+v2ij*sinphi
5691 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5695 C E = SUM ----------------------------------- - v1
5696 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5698 cosphi=dcos(0.5d0*phii)
5699 sinphi=dsin(0.5d0*phii)
5700 do j=1,nlor(itori,itori1,iblock)
5701 vl1ij=vlor1(j,itori,itori1)
5702 vl2ij=vlor2(j,itori,itori1)
5703 vl3ij=vlor3(j,itori,itori1)
5704 pom=vl2ij*cosphi+vl3ij*sinphi
5705 pom1=1.0d0/(pom*pom+1.0d0)
5706 etors=etors+vl1ij*pom1
5707 c if (energy_dec) etors_ii=etors_ii+
5710 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5712 C Subtract the constant term
5713 etors=etors-v0(itori,itori1,iblock)
5715 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5716 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5717 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5718 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5719 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5724 c----------------------------------------------------------------------------
5725 subroutine etor_d(etors_d,fact2)
5726 C 6/23/01 Compute double torsional energy
5727 implicit real*8 (a-h,o-z)
5728 include 'DIMENSIONS'
5729 include 'COMMON.VAR'
5730 include 'COMMON.GEO'
5731 include 'COMMON.LOCAL'
5732 include 'COMMON.TORSION'
5733 include 'COMMON.INTERACT'
5734 include 'COMMON.DERIV'
5735 include 'COMMON.CHAIN'
5736 include 'COMMON.NAMES'
5737 include 'COMMON.IOUNITS'
5738 include 'COMMON.FFIELD'
5739 include 'COMMON.TORCNSTR'
5741 C Set lprn=.true. for debugging
5745 do i=iphi_start,iphi_end-1
5747 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5748 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5749 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5750 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5751 & (itype(i+1).eq.ntyp1)) cycle
5752 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5754 itori=itortyp(itype(i-2))
5755 itori1=itortyp(itype(i-1))
5756 itori2=itortyp(itype(i))
5762 if (iabs(itype(i+1)).eq.20) iblock=2
5763 C Regular cosine and sine terms
5764 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5765 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5766 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5767 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5768 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5769 cosphi1=dcos(j*phii)
5770 sinphi1=dsin(j*phii)
5771 cosphi2=dcos(j*phii1)
5772 sinphi2=dsin(j*phii1)
5773 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5774 & v2cij*cosphi2+v2sij*sinphi2
5775 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5776 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5778 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5780 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5781 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5782 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5783 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5784 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5785 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5786 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5787 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5788 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5789 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5790 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5791 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5792 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5793 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5796 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5797 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5803 c---------------------------------------------------------------------------
5804 C The rigorous attempt to derive energy function
5805 subroutine etor_kcc(etors,fact)
5806 implicit real*8 (a-h,o-z)
5807 include 'DIMENSIONS'
5808 include 'COMMON.VAR'
5809 include 'COMMON.GEO'
5810 include 'COMMON.LOCAL'
5811 include 'COMMON.TORSION'
5812 include 'COMMON.INTERACT'
5813 include 'COMMON.DERIV'
5814 include 'COMMON.CHAIN'
5815 include 'COMMON.NAMES'
5816 include 'COMMON.IOUNITS'
5817 include 'COMMON.FFIELD'
5818 include 'COMMON.TORCNSTR'
5819 include 'COMMON.CONTROL'
5820 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
5822 c double precision thybt1(maxtermkcc),thybt2(maxtermkcc)
5823 C Set lprn=.true. for debugging
5826 C print *,"wchodze kcc"
5827 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
5829 do i=iphi_start,iphi_end
5830 C ANY TWO ARE DUMMY ATOMS in row CYCLE
5831 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
5832 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
5833 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
5834 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5835 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5836 itori=itortyp(itype(i-2))
5837 itori1=itortyp(itype(i-1))
5842 C to avoid multiple devision by 2
5843 c theti22=0.5d0*theta(i)
5844 C theta 12 is the theta_1 /2
5845 C theta 22 is theta_2 /2
5846 c theti12=0.5d0*theta(i-1)
5847 C and appropriate sinus function
5848 sinthet1=dsin(theta(i-1))
5849 sinthet2=dsin(theta(i))
5850 costhet1=dcos(theta(i-1))
5851 costhet2=dcos(theta(i))
5852 C to speed up lets store its mutliplication
5853 sint1t2=sinthet2*sinthet1
5855 C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
5856 C +d_n*sin(n*gamma)) *
5857 C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
5858 C we have two sum 1) Non-Chebyshev which is with n and gamma
5859 nval=nterm_kcc_Tb(itori,itori1)
5865 c1(j)=c1(j-1)*costhet1
5866 c2(j)=c2(j-1)*costhet2
5869 do j=1,nterm_kcc(itori,itori1)
5873 sint1t2n=sint1t2n*sint1t2
5879 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5880 gradvalct1=gradvalct1+
5881 & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5882 gradvalct2=gradvalct2+
5883 & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5886 gradvalct1=-gradvalct1*sinthet1
5887 gradvalct2=-gradvalct2*sinthet2
5893 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
5894 gradvalst1=gradvalst1+
5895 & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
5896 gradvalst2=gradvalst2+
5897 & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
5900 gradvalst1=-gradvalst1*sinthet1
5901 gradvalst2=-gradvalst2*sinthet2
5902 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
5903 C glocig is the gradient local i site in gamma
5904 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
5905 C now gradient over theta_1
5906 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)
5907 & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
5908 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)
5909 & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
5912 C derivative over gamma
5913 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
5914 C derivative over theta1
5915 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
5916 C now derivative over theta2
5917 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
5919 & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1,
5920 & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
5924 c---------------------------------------------------------------------------------------------
5925 subroutine etor_constr(edihcnstr)
5926 implicit real*8 (a-h,o-z)
5927 include 'DIMENSIONS'
5928 include 'COMMON.VAR'
5929 include 'COMMON.GEO'
5930 include 'COMMON.LOCAL'
5931 include 'COMMON.TORSION'
5932 include 'COMMON.INTERACT'
5933 include 'COMMON.DERIV'
5934 include 'COMMON.CHAIN'
5935 include 'COMMON.NAMES'
5936 include 'COMMON.IOUNITS'
5937 include 'COMMON.FFIELD'
5938 include 'COMMON.TORCNSTR'
5939 include 'COMMON.CONTROL'
5940 ! 6/20/98 - dihedral angle constraints
5942 c do i=1,ndih_constr
5943 c write (iout,*) "idihconstr_start",idihconstr_start,
5944 c & " idihconstr_end",idihconstr_end
5945 if (raw_psipred) then
5946 do i=idihconstr_start,idihconstr_end
5947 itori=idih_constr(i)
5949 gaudih_i=vpsipred(1,i)
5953 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
5954 dexpcos_i=dexp(-cos_i*cos_i)
5955 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
5956 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i))
5957 & *cos_i*dexpcos_i/s**2
5959 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
5960 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
5962 & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)')
5963 & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),
5964 & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),
5965 & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,
5966 & -wdihc*dlog(gaudih_i)
5969 do i=idihconstr_start,idihconstr_end
5970 itori=idih_constr(i)
5972 difi=pinorm(phii-phi0(i))
5973 if (difi.gt.drange(i)) then
5975 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5976 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5977 else if (difi.lt.-drange(i)) then
5979 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5980 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5988 c----------------------------------------------------------------------------
5989 C The rigorous attempt to derive energy function
5990 subroutine ebend_kcc(etheta)
5992 implicit real*8 (a-h,o-z)
5993 include 'DIMENSIONS'
5994 include 'COMMON.VAR'
5995 include 'COMMON.GEO'
5996 include 'COMMON.LOCAL'
5997 include 'COMMON.TORSION'
5998 include 'COMMON.INTERACT'
5999 include 'COMMON.DERIV'
6000 include 'COMMON.CHAIN'
6001 include 'COMMON.NAMES'
6002 include 'COMMON.IOUNITS'
6003 include 'COMMON.FFIELD'
6004 include 'COMMON.TORCNSTR'
6005 include 'COMMON.CONTROL'
6007 double precision thybt1(maxang_kcc)
6008 C Set lprn=.true. for debugging
6011 C print *,"wchodze kcc"
6012 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
6014 do i=ithet_start,ithet_end
6015 c print *,i,itype(i-1),itype(i),itype(i-2)
6016 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
6017 & .or.itype(i).eq.ntyp1) cycle
6018 iti=iabs(itortyp(itype(i-1)))
6019 sinthet=dsin(theta(i))
6020 costhet=dcos(theta(i))
6021 do j=1,nbend_kcc_Tb(iti)
6022 thybt1(j)=v1bend_chyb(j,iti)
6024 sumth1thyb=v1bend_chyb(0,iti)+
6025 & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
6026 if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg,
6028 ihelp=nbend_kcc_Tb(iti)-1
6029 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
6030 etheta=etheta+sumth1thyb
6031 C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
6032 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
6036 c-------------------------------------------------------------------------------------
6037 subroutine etheta_constr(ethetacnstr)
6039 implicit real*8 (a-h,o-z)
6040 include 'DIMENSIONS'
6041 include 'COMMON.VAR'
6042 include 'COMMON.GEO'
6043 include 'COMMON.LOCAL'
6044 include 'COMMON.TORSION'
6045 include 'COMMON.INTERACT'
6046 include 'COMMON.DERIV'
6047 include 'COMMON.CHAIN'
6048 include 'COMMON.NAMES'
6049 include 'COMMON.IOUNITS'
6050 include 'COMMON.FFIELD'
6051 include 'COMMON.TORCNSTR'
6052 include 'COMMON.CONTROL'
6054 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
6055 do i=ithetaconstr_start,ithetaconstr_end
6056 itheta=itheta_constr(i)
6057 thetiii=theta(itheta)
6058 difi=pinorm(thetiii-theta_constr0(i))
6059 if (difi.gt.theta_drange(i)) then
6060 difi=difi-theta_drange(i)
6061 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6062 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6063 & +for_thet_constr(i)*difi**3
6064 else if (difi.lt.-drange(i)) then
6066 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
6067 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
6068 & +for_thet_constr(i)*difi**3
6072 if (energy_dec) then
6073 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
6074 & i,itheta,rad2deg*thetiii,
6075 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
6076 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
6077 & gloc(itheta+nphi-2,icg)
6082 c------------------------------------------------------------------------------
6083 c------------------------------------------------------------------------------
6084 subroutine eback_sc_corr(esccor)
6085 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6086 c conformational states; temporarily implemented as differences
6087 c between UNRES torsional potentials (dependent on three types of
6088 c residues) and the torsional potentials dependent on all 20 types
6089 c of residues computed from AM1 energy surfaces of terminally-blocked
6090 c amino-acid residues.
6091 implicit real*8 (a-h,o-z)
6092 include 'DIMENSIONS'
6093 include 'COMMON.VAR'
6094 include 'COMMON.GEO'
6095 include 'COMMON.LOCAL'
6096 include 'COMMON.TORSION'
6097 include 'COMMON.SCCOR'
6098 include 'COMMON.INTERACT'
6099 include 'COMMON.DERIV'
6100 include 'COMMON.CHAIN'
6101 include 'COMMON.NAMES'
6102 include 'COMMON.IOUNITS'
6103 include 'COMMON.FFIELD'
6104 include 'COMMON.CONTROL'
6106 C Set lprn=.true. for debugging
6109 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6111 do i=itau_start,itau_end
6112 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6114 isccori=isccortyp(itype(i-2))
6115 isccori1=isccortyp(itype(i-1))
6117 do intertyp=1,3 !intertyp
6118 cc Added 09 May 2012 (Adasko)
6119 cc Intertyp means interaction type of backbone mainchain correlation:
6120 c 1 = SC...Ca...Ca...Ca
6121 c 2 = Ca...Ca...Ca...SC
6122 c 3 = SC...Ca...Ca...SCi
6124 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6125 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6126 & (itype(i-1).eq.ntyp1)))
6127 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6128 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6129 & .or.(itype(i).eq.ntyp1)))
6130 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6131 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6132 & (itype(i-3).eq.ntyp1)))) cycle
6133 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6134 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6136 do j=1,nterm_sccor(isccori,isccori1)
6137 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6138 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6139 cosphi=dcos(j*tauangle(intertyp,i))
6140 sinphi=dsin(j*tauangle(intertyp,i))
6141 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6142 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6144 C write (iout,*)"EBACK_SC_COR",esccor,i
6145 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
6146 c & nterm_sccor(isccori,isccori1),isccori,isccori1
6147 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6149 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6150 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6151 & (v1sccor(j,1,itori,itori1),j=1,6)
6152 & ,(v2sccor(j,1,itori,itori1),j=1,6)
6153 c gsccor_loc(i-3)=gloci
6158 c------------------------------------------------------------------------------
6159 subroutine multibody(ecorr)
6160 C This subroutine calculates multi-body contributions to energy following
6161 C the idea of Skolnick et al. If side chains I and J make a contact and
6162 C at the same time side chains I+1 and J+1 make a contact, an extra
6163 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6164 implicit real*8 (a-h,o-z)
6165 include 'DIMENSIONS'
6166 include 'COMMON.IOUNITS'
6167 include 'COMMON.DERIV'
6168 include 'COMMON.INTERACT'
6169 include 'COMMON.CONTACTS'
6170 double precision gx(3),gx1(3)
6173 C Set lprn=.true. for debugging
6177 write (iout,'(a)') 'Contact function values:'
6179 write (iout,'(i2,20(1x,i2,f10.5))')
6180 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6195 num_conti=num_cont(i)
6196 num_conti1=num_cont(i1)
6201 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6202 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6203 cd & ' ishift=',ishift
6204 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6205 C The system gains extra energy.
6206 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6207 endif ! j1==j+-ishift
6216 c------------------------------------------------------------------------------
6217 double precision function esccorr(i,j,k,l,jj,kk)
6218 implicit real*8 (a-h,o-z)
6219 include 'DIMENSIONS'
6220 include 'COMMON.IOUNITS'
6221 include 'COMMON.DERIV'
6222 include 'COMMON.INTERACT'
6223 include 'COMMON.CONTACTS'
6224 double precision gx(3),gx1(3)
6229 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6230 C Calculate the multi-body contribution to energy.
6231 C Calculate multi-body contributions to the gradient.
6232 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6233 cd & k,l,(gacont(m,kk,k),m=1,3)
6235 gx(m) =ekl*gacont(m,jj,i)
6236 gx1(m)=eij*gacont(m,kk,k)
6237 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6238 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6239 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6240 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6244 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6249 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6255 c------------------------------------------------------------------------------
6256 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6257 C This subroutine calculates multi-body contributions to hydrogen-bonding
6258 implicit real*8 (a-h,o-z)
6259 include 'DIMENSIONS'
6260 include 'COMMON.IOUNITS'
6261 include 'COMMON.FFIELD'
6262 include 'COMMON.DERIV'
6263 include 'COMMON.INTERACT'
6264 include 'COMMON.CONTACTS'
6265 double precision gx(3),gx1(3)
6268 C Set lprn=.true. for debugging
6271 write (iout,'(a)') 'Contact function values:'
6273 write (iout,'(2i3,50(1x,i2,f5.2))')
6274 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6275 & j=1,num_cont_hb(i))
6279 C Remove the loop below after debugging !!!
6286 C Calculate the local-electrostatic correlation terms
6287 do i=iatel_s,iatel_e+1
6289 num_conti=num_cont_hb(i)
6290 num_conti1=num_cont_hb(i+1)
6295 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6296 c & ' jj=',jj,' kk=',kk
6297 if (j1.eq.j+1 .or. j1.eq.j-1) then
6298 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6299 C The system gains extra energy.
6300 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6302 else if (j1.eq.j) then
6303 C Contacts I-J and I-(J+1) occur simultaneously.
6304 C The system loses extra energy.
6305 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6310 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6311 c & ' jj=',jj,' kk=',kk
6313 C Contacts I-J and (I+1)-J occur simultaneously.
6314 C The system loses extra energy.
6315 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6322 c------------------------------------------------------------------------------
6323 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6325 C This subroutine calculates multi-body contributions to hydrogen-bonding
6326 implicit real*8 (a-h,o-z)
6327 include 'DIMENSIONS'
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 'COMMON.IOUNITS'
6490 include 'COMMON.DERIV'
6491 include 'COMMON.INTERACT'
6492 include 'COMMON.CONTACTS'
6493 include 'COMMON.SHIELD'
6494 include 'COMMON.CONTROL'
6495 double precision gx(3),gx1(3)
6498 C print *,"wchodze",fac_shield(i),shield_mode
6506 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6508 C & fac_shield(i)**2*fac_shield(j)**2
6509 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6510 C Following 4 lines for diagnostics.
6515 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6516 c & 'Contacts ',i,j,
6517 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6518 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6520 C Calculate the multi-body contribution to energy.
6521 C ecorr=ecorr+ekont*ees
6522 C Calculate multi-body contributions to the gradient.
6523 coeffpees0pij=coeffp*ees0pij
6524 coeffmees0mij=coeffm*ees0mij
6525 coeffpees0pkl=coeffp*ees0pkl
6526 coeffmees0mkl=coeffm*ees0mkl
6528 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6529 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6530 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6531 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6532 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6533 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6534 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6535 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6536 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6537 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6538 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6539 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6540 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6541 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6542 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6543 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6544 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6545 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6546 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6547 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6548 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6549 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6550 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6551 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6552 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6557 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6558 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6559 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6560 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6565 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6566 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6567 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6568 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6571 c write (iout,*) "ehbcorr",ekont*ees
6572 C print *,ekont,ees,i,k
6574 C now gradient over shielding
6576 if (shield_mode.gt.0) then
6579 C print *,i,j,fac_shield(i),fac_shield(j),
6580 C &fac_shield(k),fac_shield(l)
6581 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6582 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6583 do ilist=1,ishield_list(i)
6584 iresshield=shield_list(ilist,i)
6586 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6588 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6590 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6591 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6595 do ilist=1,ishield_list(j)
6596 iresshield=shield_list(ilist,j)
6598 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6600 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6602 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6603 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6608 do ilist=1,ishield_list(k)
6609 iresshield=shield_list(ilist,k)
6611 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6613 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6615 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6616 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6620 do ilist=1,ishield_list(l)
6621 iresshield=shield_list(ilist,l)
6623 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6625 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6627 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6628 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6632 C print *,gshieldx(m,iresshield)
6634 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6635 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6636 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6637 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6638 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6639 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6640 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6641 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6643 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6644 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6645 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6646 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6647 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6648 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6649 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6650 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6658 C---------------------------------------------------------------------------
6659 subroutine dipole(i,j,jj)
6660 implicit real*8 (a-h,o-z)
6661 include 'DIMENSIONS'
6662 include 'COMMON.IOUNITS'
6663 include 'COMMON.CHAIN'
6664 include 'COMMON.FFIELD'
6665 include 'COMMON.DERIV'
6666 include 'COMMON.INTERACT'
6667 include 'COMMON.CONTACTS'
6668 include 'COMMON.TORSION'
6669 include 'COMMON.VAR'
6670 include 'COMMON.GEO'
6671 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6673 iti1 = itortyp(itype(i+1))
6674 if (j.lt.nres-1) then
6675 itj1 = itype2loc(itype(j+1))
6680 dipi(iii,1)=Ub2(iii,i)
6681 dipderi(iii)=Ub2der(iii,i)
6682 dipi(iii,2)=b1(iii,i+1)
6683 dipj(iii,1)=Ub2(iii,j)
6684 dipderj(iii)=Ub2der(iii,j)
6685 dipj(iii,2)=b1(iii,j+1)
6689 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6692 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6699 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6703 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6708 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6709 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6711 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6713 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6715 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6720 C---------------------------------------------------------------------------
6721 subroutine calc_eello(i,j,k,l,jj,kk)
6723 C This subroutine computes matrices and vectors needed to calculate
6724 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6726 implicit real*8 (a-h,o-z)
6727 include 'DIMENSIONS'
6728 include 'COMMON.IOUNITS'
6729 include 'COMMON.CHAIN'
6730 include 'COMMON.DERIV'
6731 include 'COMMON.INTERACT'
6732 include 'COMMON.CONTACTS'
6733 include 'COMMON.TORSION'
6734 include 'COMMON.VAR'
6735 include 'COMMON.GEO'
6736 include 'COMMON.FFIELD'
6737 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6738 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6741 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6742 cd & ' jj=',jj,' kk=',kk
6743 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6744 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6745 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6748 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6749 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6752 call transpose2(aa1(1,1),aa1t(1,1))
6753 call transpose2(aa2(1,1),aa2t(1,1))
6756 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6757 & aa1tder(1,1,lll,kkk))
6758 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6759 & aa2tder(1,1,lll,kkk))
6763 C parallel orientation of the two CA-CA-CA frames.
6765 iti=itype2loc(itype(i))
6769 itk1=itype2loc(itype(k+1))
6770 itj=itype2loc(itype(j))
6771 if (l.lt.nres-1) then
6772 itl1=itype2loc(itype(l+1))
6776 C A1 kernel(j+1) A2T
6778 cd write (iout,'(3f10.5,5x,3f10.5)')
6779 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6781 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6782 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6783 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6784 C Following matrices are needed only for 6-th order cumulants
6785 IF (wcorr6.gt.0.0d0) THEN
6786 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6787 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6788 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6789 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6790 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6791 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6792 & ADtEAderx(1,1,1,1,1,1))
6794 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6795 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6796 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6797 & ADtEA1derx(1,1,1,1,1,1))
6799 C End 6-th order cumulants
6802 cd write (2,*) 'In calc_eello6'
6804 cd write (2,*) 'iii=',iii
6806 cd write (2,*) 'kkk=',kkk
6808 cd write (2,'(3(2f10.5),5x)')
6809 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6814 call transpose2(EUgder(1,1,k),auxmat(1,1))
6815 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6816 call transpose2(EUg(1,1,k),auxmat(1,1))
6817 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6818 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6822 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6823 & EAEAderx(1,1,lll,kkk,iii,1))
6827 C A1T kernel(i+1) A2
6828 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6829 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6830 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6831 C Following matrices are needed only for 6-th order cumulants
6832 IF (wcorr6.gt.0.0d0) THEN
6833 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6834 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6835 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6836 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6837 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6838 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6839 & ADtEAderx(1,1,1,1,1,2))
6840 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6841 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6842 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6843 & ADtEA1derx(1,1,1,1,1,2))
6845 C End 6-th order cumulants
6846 call transpose2(EUgder(1,1,l),auxmat(1,1))
6847 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6848 call transpose2(EUg(1,1,l),auxmat(1,1))
6849 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6850 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6854 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6855 & EAEAderx(1,1,lll,kkk,iii,2))
6860 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6861 C They are needed only when the fifth- or the sixth-order cumulants are
6863 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6864 call transpose2(AEA(1,1,1),auxmat(1,1))
6865 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
6866 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6867 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6868 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6869 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
6870 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6871 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
6872 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
6873 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6874 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6875 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6876 call transpose2(AEA(1,1,2),auxmat(1,1))
6877 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
6878 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6879 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6880 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6881 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
6882 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6883 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
6884 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
6885 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6886 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6887 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6888 C Calculate the Cartesian derivatives of the vectors.
6892 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6893 call matvec2(auxmat(1,1),b1(1,i),
6894 & AEAb1derx(1,lll,kkk,iii,1,1))
6895 call matvec2(auxmat(1,1),Ub2(1,i),
6896 & AEAb2derx(1,lll,kkk,iii,1,1))
6897 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
6898 & AEAb1derx(1,lll,kkk,iii,2,1))
6899 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6900 & AEAb2derx(1,lll,kkk,iii,2,1))
6901 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6902 call matvec2(auxmat(1,1),b1(1,j),
6903 & AEAb1derx(1,lll,kkk,iii,1,2))
6904 call matvec2(auxmat(1,1),Ub2(1,j),
6905 & AEAb2derx(1,lll,kkk,iii,1,2))
6906 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
6907 & AEAb1derx(1,lll,kkk,iii,2,2))
6908 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6909 & AEAb2derx(1,lll,kkk,iii,2,2))
6916 C Antiparallel orientation of the two CA-CA-CA frames.
6918 iti=itype2loc(itype(i))
6922 itk1=itype2loc(itype(k+1))
6923 itl=itype2loc(itype(l))
6924 itj=itype2loc(itype(j))
6925 if (j.lt.nres-1) then
6926 itj1=itype2loc(itype(j+1))
6930 C A2 kernel(j-1)T A1T
6931 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6932 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6933 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6934 C Following matrices are needed only for 6-th order cumulants
6935 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6936 & j.eq.i+4 .and. l.eq.i+3)) THEN
6937 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6938 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6939 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6940 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6941 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6942 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6943 & ADtEAderx(1,1,1,1,1,1))
6944 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6945 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6946 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6947 & ADtEA1derx(1,1,1,1,1,1))
6949 C End 6-th order cumulants
6950 call transpose2(EUgder(1,1,k),auxmat(1,1))
6951 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6952 call transpose2(EUg(1,1,k),auxmat(1,1))
6953 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6954 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6958 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6959 & EAEAderx(1,1,lll,kkk,iii,1))
6963 C A2T kernel(i+1)T A1
6964 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6965 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6966 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6967 C Following matrices are needed only for 6-th order cumulants
6968 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6969 & j.eq.i+4 .and. l.eq.i+3)) THEN
6970 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6971 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6972 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6973 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6974 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6975 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6976 & ADtEAderx(1,1,1,1,1,2))
6977 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6978 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6979 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6980 & ADtEA1derx(1,1,1,1,1,2))
6982 C End 6-th order cumulants
6983 call transpose2(EUgder(1,1,j),auxmat(1,1))
6984 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6985 call transpose2(EUg(1,1,j),auxmat(1,1))
6986 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6987 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6991 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6992 & EAEAderx(1,1,lll,kkk,iii,2))
6997 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6998 C They are needed only when the fifth- or the sixth-order cumulants are
7000 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7001 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7002 call transpose2(AEA(1,1,1),auxmat(1,1))
7003 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7004 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7005 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7006 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7007 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7008 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7009 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7010 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7011 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7012 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7013 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7014 call transpose2(AEA(1,1,2),auxmat(1,1))
7015 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7016 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7017 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7018 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7019 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7020 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7021 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7022 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7023 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7024 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7025 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7026 C Calculate the Cartesian derivatives of the vectors.
7030 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7031 call matvec2(auxmat(1,1),b1(1,i),
7032 & AEAb1derx(1,lll,kkk,iii,1,1))
7033 call matvec2(auxmat(1,1),Ub2(1,i),
7034 & AEAb2derx(1,lll,kkk,iii,1,1))
7035 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7036 & AEAb1derx(1,lll,kkk,iii,2,1))
7037 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7038 & AEAb2derx(1,lll,kkk,iii,2,1))
7039 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7040 call matvec2(auxmat(1,1),b1(1,l),
7041 & AEAb1derx(1,lll,kkk,iii,1,2))
7042 call matvec2(auxmat(1,1),Ub2(1,l),
7043 & AEAb2derx(1,lll,kkk,iii,1,2))
7044 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7045 & AEAb1derx(1,lll,kkk,iii,2,2))
7046 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7047 & AEAb2derx(1,lll,kkk,iii,2,2))
7056 C---------------------------------------------------------------------------
7057 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7058 & KK,KKderg,AKA,AKAderg,AKAderx)
7062 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7063 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7064 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7069 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7071 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7074 cd if (lprn) write (2,*) 'In kernel'
7076 cd if (lprn) write (2,*) 'kkk=',kkk
7078 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7079 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7081 cd write (2,*) 'lll=',lll
7082 cd write (2,*) 'iii=1'
7084 cd write (2,'(3(2f10.5),5x)')
7085 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7088 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7089 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7091 cd write (2,*) 'lll=',lll
7092 cd write (2,*) 'iii=2'
7094 cd write (2,'(3(2f10.5),5x)')
7095 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7102 C---------------------------------------------------------------------------
7103 double precision function eello4(i,j,k,l,jj,kk)
7104 implicit real*8 (a-h,o-z)
7105 include 'DIMENSIONS'
7106 include 'COMMON.IOUNITS'
7107 include 'COMMON.CHAIN'
7108 include 'COMMON.DERIV'
7109 include 'COMMON.INTERACT'
7110 include 'COMMON.CONTACTS'
7111 include 'COMMON.TORSION'
7112 include 'COMMON.VAR'
7113 include 'COMMON.GEO'
7114 double precision pizda(2,2),ggg1(3),ggg2(3)
7115 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7119 cd print *,'eello4:',i,j,k,l,jj,kk
7120 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7121 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7122 cold eij=facont_hb(jj,i)
7123 cold ekl=facont_hb(kk,k)
7125 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7127 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7128 gcorr_loc(k-1)=gcorr_loc(k-1)
7129 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7131 gcorr_loc(l-1)=gcorr_loc(l-1)
7132 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7134 gcorr_loc(j-1)=gcorr_loc(j-1)
7135 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7140 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7141 & -EAEAderx(2,2,lll,kkk,iii,1)
7142 cd derx(lll,kkk,iii)=0.0d0
7146 cd gcorr_loc(l-1)=0.0d0
7147 cd gcorr_loc(j-1)=0.0d0
7148 cd gcorr_loc(k-1)=0.0d0
7150 cd write (iout,*)'Contacts have occurred for peptide groups',
7151 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7152 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7153 if (j.lt.nres-1) then
7160 if (l.lt.nres-1) then
7168 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7169 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7170 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7171 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7172 cgrad ghalf=0.5d0*ggg1(ll)
7173 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7174 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7175 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7176 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7177 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7178 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7179 cgrad ghalf=0.5d0*ggg2(ll)
7180 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7181 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7182 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7183 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7184 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7185 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7189 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7194 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7199 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7204 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7208 cd write (2,*) iii,gcorr_loc(iii)
7212 cd write (2,*) 'ekont',ekont
7213 cd write (iout,*) 'eello4',ekont*eel4
7216 C---------------------------------------------------------------------------
7217 double precision function eello5(i,j,k,l,jj,kk)
7218 implicit real*8 (a-h,o-z)
7219 include 'DIMENSIONS'
7220 include 'COMMON.IOUNITS'
7221 include 'COMMON.CHAIN'
7222 include 'COMMON.DERIV'
7223 include 'COMMON.INTERACT'
7224 include 'COMMON.CONTACTS'
7225 include 'COMMON.TORSION'
7226 include 'COMMON.VAR'
7227 include 'COMMON.GEO'
7228 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7229 double precision ggg1(3),ggg2(3)
7230 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7235 C /l\ / \ \ / \ / \ / C
7236 C / \ / \ \ / \ / \ / C
7237 C j| o |l1 | o | o| o | | o |o C
7238 C \ |/k\| |/ \| / |/ \| |/ \| C
7239 C \i/ \ / \ / / \ / \ C
7241 C (I) (II) (III) (IV) C
7243 C eello5_1 eello5_2 eello5_3 eello5_4 C
7245 C Antiparallel chains C
7248 C /j\ / \ \ / \ / \ / C
7249 C / \ / \ \ / \ / \ / C
7250 C j1| o |l | o | o| o | | o |o C
7251 C \ |/k\| |/ \| / |/ \| |/ \| C
7252 C \i/ \ / \ / / \ / \ C
7254 C (I) (II) (III) (IV) C
7256 C eello5_1 eello5_2 eello5_3 eello5_4 C
7258 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7260 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7261 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7266 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7268 itk=itype2loc(itype(k))
7269 itl=itype2loc(itype(l))
7270 itj=itype2loc(itype(j))
7275 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7276 cd & eel5_3_num,eel5_4_num)
7280 derx(lll,kkk,iii)=0.0d0
7284 cd eij=facont_hb(jj,i)
7285 cd ekl=facont_hb(kk,k)
7287 cd write (iout,*)'Contacts have occurred for peptide groups',
7288 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7290 C Contribution from the graph I.
7291 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7292 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7293 call transpose2(EUg(1,1,k),auxmat(1,1))
7294 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7295 vv(1)=pizda(1,1)-pizda(2,2)
7296 vv(2)=pizda(1,2)+pizda(2,1)
7297 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7298 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7300 C Explicit gradient in virtual-dihedral angles.
7301 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7302 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7303 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7304 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7305 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7306 vv(1)=pizda(1,1)-pizda(2,2)
7307 vv(2)=pizda(1,2)+pizda(2,1)
7308 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7309 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7310 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7311 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7312 vv(1)=pizda(1,1)-pizda(2,2)
7313 vv(2)=pizda(1,2)+pizda(2,1)
7315 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7316 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7317 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7319 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7320 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7321 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7323 C Cartesian gradient
7327 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7329 vv(1)=pizda(1,1)-pizda(2,2)
7330 vv(2)=pizda(1,2)+pizda(2,1)
7331 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7332 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7333 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7340 C Contribution from graph II
7341 call transpose2(EE(1,1,k),auxmat(1,1))
7342 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7343 vv(1)=pizda(1,1)+pizda(2,2)
7344 vv(2)=pizda(2,1)-pizda(1,2)
7345 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7346 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7348 C Explicit gradient in virtual-dihedral angles.
7349 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7350 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7351 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7352 vv(1)=pizda(1,1)+pizda(2,2)
7353 vv(2)=pizda(2,1)-pizda(1,2)
7355 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7356 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7357 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7359 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7360 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7361 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7363 C Cartesian gradient
7367 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7369 vv(1)=pizda(1,1)+pizda(2,2)
7370 vv(2)=pizda(2,1)-pizda(1,2)
7371 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7372 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7373 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7382 C Parallel orientation
7383 C Contribution from graph III
7384 call transpose2(EUg(1,1,l),auxmat(1,1))
7385 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7386 vv(1)=pizda(1,1)-pizda(2,2)
7387 vv(2)=pizda(1,2)+pizda(2,1)
7388 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7389 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7391 C Explicit gradient in virtual-dihedral angles.
7392 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7393 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7394 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7395 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7396 vv(1)=pizda(1,1)-pizda(2,2)
7397 vv(2)=pizda(1,2)+pizda(2,1)
7398 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7399 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7400 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7401 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7402 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7403 vv(1)=pizda(1,1)-pizda(2,2)
7404 vv(2)=pizda(1,2)+pizda(2,1)
7405 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7406 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7407 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7408 C Cartesian gradient
7412 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7414 vv(1)=pizda(1,1)-pizda(2,2)
7415 vv(2)=pizda(1,2)+pizda(2,1)
7416 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7417 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7418 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7423 C Contribution from graph IV
7425 call transpose2(EE(1,1,l),auxmat(1,1))
7426 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7427 vv(1)=pizda(1,1)+pizda(2,2)
7428 vv(2)=pizda(2,1)-pizda(1,2)
7429 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7430 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7431 C Explicit gradient in virtual-dihedral angles.
7432 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7433 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7434 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7435 vv(1)=pizda(1,1)+pizda(2,2)
7436 vv(2)=pizda(2,1)-pizda(1,2)
7437 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7438 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7439 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7440 C Cartesian gradient
7444 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7446 vv(1)=pizda(1,1)+pizda(2,2)
7447 vv(2)=pizda(2,1)-pizda(1,2)
7448 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7449 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7450 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7456 C Antiparallel orientation
7457 C Contribution from graph III
7459 call transpose2(EUg(1,1,j),auxmat(1,1))
7460 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7461 vv(1)=pizda(1,1)-pizda(2,2)
7462 vv(2)=pizda(1,2)+pizda(2,1)
7463 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7464 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7466 C Explicit gradient in virtual-dihedral angles.
7467 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7468 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7469 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7470 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7471 vv(1)=pizda(1,1)-pizda(2,2)
7472 vv(2)=pizda(1,2)+pizda(2,1)
7473 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7474 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7475 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7476 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7477 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7478 vv(1)=pizda(1,1)-pizda(2,2)
7479 vv(2)=pizda(1,2)+pizda(2,1)
7480 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7481 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7482 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7483 C Cartesian gradient
7487 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7489 vv(1)=pizda(1,1)-pizda(2,2)
7490 vv(2)=pizda(1,2)+pizda(2,1)
7491 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7492 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7493 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7499 C Contribution from graph IV
7501 call transpose2(EE(1,1,j),auxmat(1,1))
7502 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7503 vv(1)=pizda(1,1)+pizda(2,2)
7504 vv(2)=pizda(2,1)-pizda(1,2)
7505 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7506 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7508 C Explicit gradient in virtual-dihedral angles.
7509 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7510 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7511 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7512 vv(1)=pizda(1,1)+pizda(2,2)
7513 vv(2)=pizda(2,1)-pizda(1,2)
7514 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7515 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7516 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7517 C Cartesian gradient
7521 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7523 vv(1)=pizda(1,1)+pizda(2,2)
7524 vv(2)=pizda(2,1)-pizda(1,2)
7525 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7526 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7527 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7534 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7535 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7536 cd write (2,*) 'ijkl',i,j,k,l
7537 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7538 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7540 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7541 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7542 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7543 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7545 if (j.lt.nres-1) then
7552 if (l.lt.nres-1) then
7562 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7563 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7564 C summed up outside the subrouine as for the other subroutines
7565 C handling long-range interactions. The old code is commented out
7566 C with "cgrad" to keep track of changes.
7568 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7569 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7570 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7571 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7572 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7573 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7574 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7575 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7576 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7577 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7579 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7580 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7581 cgrad ghalf=0.5d0*ggg1(ll)
7583 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7584 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7585 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7586 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7587 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7588 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7589 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7590 cgrad ghalf=0.5d0*ggg2(ll)
7592 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7593 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7594 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7595 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7596 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7597 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7603 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7604 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7609 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7610 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7616 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7621 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7625 cd write (2,*) iii,g_corr5_loc(iii)
7628 cd write (2,*) 'ekont',ekont
7629 cd write (iout,*) 'eello5',ekont*eel5
7632 c--------------------------------------------------------------------------
7633 double precision function eello6(i,j,k,l,jj,kk)
7634 implicit real*8 (a-h,o-z)
7635 include 'DIMENSIONS'
7636 include 'COMMON.IOUNITS'
7637 include 'COMMON.CHAIN'
7638 include 'COMMON.DERIV'
7639 include 'COMMON.INTERACT'
7640 include 'COMMON.CONTACTS'
7641 include 'COMMON.TORSION'
7642 include 'COMMON.VAR'
7643 include 'COMMON.GEO'
7644 include 'COMMON.FFIELD'
7645 double precision ggg1(3),ggg2(3)
7646 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7651 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7659 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7660 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7664 derx(lll,kkk,iii)=0.0d0
7668 cd eij=facont_hb(jj,i)
7669 cd ekl=facont_hb(kk,k)
7675 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7676 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7677 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7678 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7679 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7680 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7682 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7683 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7684 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7685 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7686 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7687 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7691 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7693 C If turn contributions are considered, they will be handled separately.
7694 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7695 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7696 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7697 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7698 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7699 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7700 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7703 if (j.lt.nres-1) then
7710 if (l.lt.nres-1) then
7718 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7719 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7720 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7721 cgrad ghalf=0.5d0*ggg1(ll)
7723 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7724 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7725 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7726 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7727 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7728 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7729 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7730 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7731 cgrad ghalf=0.5d0*ggg2(ll)
7732 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7734 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7735 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7736 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7737 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7738 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7739 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7745 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7746 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7751 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7752 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7758 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7763 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7767 cd write (2,*) iii,g_corr6_loc(iii)
7770 cd write (2,*) 'ekont',ekont
7771 cd write (iout,*) 'eello6',ekont*eel6
7774 c--------------------------------------------------------------------------
7775 double precision function eello6_graph1(i,j,k,l,imat,swap)
7776 implicit real*8 (a-h,o-z)
7777 include 'DIMENSIONS'
7778 include 'COMMON.IOUNITS'
7779 include 'COMMON.CHAIN'
7780 include 'COMMON.DERIV'
7781 include 'COMMON.INTERACT'
7782 include 'COMMON.CONTACTS'
7783 include 'COMMON.TORSION'
7784 include 'COMMON.VAR'
7785 include 'COMMON.GEO'
7786 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7790 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7792 C Parallel Antiparallel C
7798 C \ j|/k\| / \ |/k\|l / C
7803 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7804 itk=itype2loc(itype(k))
7805 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7806 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7807 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7808 call transpose2(EUgC(1,1,k),auxmat(1,1))
7809 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7810 vv1(1)=pizda1(1,1)-pizda1(2,2)
7811 vv1(2)=pizda1(1,2)+pizda1(2,1)
7812 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7813 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
7814 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
7815 s5=scalar2(vv(1),Dtobr2(1,i))
7816 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7817 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7819 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7820 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7821 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7822 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7823 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7824 & +scalar2(vv(1),Dtobr2der(1,i)))
7825 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7826 vv1(1)=pizda1(1,1)-pizda1(2,2)
7827 vv1(2)=pizda1(1,2)+pizda1(2,1)
7828 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
7829 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
7831 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7832 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7833 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7834 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7835 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7837 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7838 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7839 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7840 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7841 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7843 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7844 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7845 vv1(1)=pizda1(1,1)-pizda1(2,2)
7846 vv1(2)=pizda1(1,2)+pizda1(2,1)
7847 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7848 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7849 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7850 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7859 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7860 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7861 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7862 call transpose2(EUgC(1,1,k),auxmat(1,1))
7863 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7865 vv1(1)=pizda1(1,1)-pizda1(2,2)
7866 vv1(2)=pizda1(1,2)+pizda1(2,1)
7867 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7868 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
7869 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
7870 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
7871 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
7872 s5=scalar2(vv(1),Dtobr2(1,i))
7873 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7880 c----------------------------------------------------------------------------
7881 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7882 implicit real*8 (a-h,o-z)
7883 include 'DIMENSIONS'
7884 include 'COMMON.IOUNITS'
7885 include 'COMMON.CHAIN'
7886 include 'COMMON.DERIV'
7887 include 'COMMON.INTERACT'
7888 include 'COMMON.CONTACTS'
7889 include 'COMMON.TORSION'
7890 include 'COMMON.VAR'
7891 include 'COMMON.GEO'
7893 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7894 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7897 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7899 C Parallel Antiparallel C
7905 C \ j|/k\| \ |/k\|l C
7910 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7911 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7912 C AL 7/4/01 s1 would occur in the sixth-order moment,
7913 C but not in a cluster cumulant
7915 s1=dip(1,jj,i)*dip(1,kk,k)
7917 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7918 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7919 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7920 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7921 call transpose2(EUg(1,1,k),auxmat(1,1))
7922 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7923 vv(1)=pizda(1,1)-pizda(2,2)
7924 vv(2)=pizda(1,2)+pizda(2,1)
7925 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7926 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7928 eello6_graph2=-(s1+s2+s3+s4)
7930 eello6_graph2=-(s2+s3+s4)
7933 C Derivatives in gamma(i-1)
7937 s1=dipderg(1,jj,i)*dip(1,kk,k)
7939 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7940 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7941 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7942 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7944 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7946 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7948 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7950 C Derivatives in gamma(k-1)
7952 s1=dip(1,jj,i)*dipderg(1,kk,k)
7954 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7955 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7956 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7957 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7958 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7959 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7960 vv(1)=pizda(1,1)-pizda(2,2)
7961 vv(2)=pizda(1,2)+pizda(2,1)
7962 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7964 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7966 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7968 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7969 C Derivatives in gamma(j-1) or gamma(l-1)
7972 s1=dipderg(3,jj,i)*dip(1,kk,k)
7974 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7975 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7976 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7977 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7978 vv(1)=pizda(1,1)-pizda(2,2)
7979 vv(2)=pizda(1,2)+pizda(2,1)
7980 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7983 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7985 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7988 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7989 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7991 C Derivatives in gamma(l-1) or gamma(j-1)
7994 s1=dip(1,jj,i)*dipderg(3,kk,k)
7996 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7997 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7998 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7999 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8000 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8001 vv(1)=pizda(1,1)-pizda(2,2)
8002 vv(2)=pizda(1,2)+pizda(2,1)
8003 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8006 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8008 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8011 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8012 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8014 C Cartesian derivatives.
8016 write (2,*) 'In eello6_graph2'
8018 write (2,*) 'iii=',iii
8020 write (2,*) 'kkk=',kkk
8022 write (2,'(3(2f10.5),5x)')
8023 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8033 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8035 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8038 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8040 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8041 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8043 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8044 call transpose2(EUg(1,1,k),auxmat(1,1))
8045 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8047 vv(1)=pizda(1,1)-pizda(2,2)
8048 vv(2)=pizda(1,2)+pizda(2,1)
8049 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8050 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8052 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8054 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8057 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8059 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8067 c----------------------------------------------------------------------------
8068 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8069 implicit real*8 (a-h,o-z)
8070 include 'DIMENSIONS'
8071 include 'COMMON.IOUNITS'
8072 include 'COMMON.CHAIN'
8073 include 'COMMON.DERIV'
8074 include 'COMMON.INTERACT'
8075 include 'COMMON.CONTACTS'
8076 include 'COMMON.TORSION'
8077 include 'COMMON.VAR'
8078 include 'COMMON.GEO'
8079 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8081 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8083 C Parallel Antiparallel C
8089 C j|/k\| / |/k\|l / C
8094 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8096 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8097 C energy moment and not to the cluster cumulant.
8098 iti=itortyp(itype(i))
8099 if (j.lt.nres-1) then
8100 itj1=itype2loc(itype(j+1))
8104 itk=itype2loc(itype(k))
8105 itk1=itype2loc(itype(k+1))
8106 if (l.lt.nres-1) then
8107 itl1=itype2loc(itype(l+1))
8112 s1=dip(4,jj,i)*dip(4,kk,k)
8114 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8115 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8116 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8117 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8118 call transpose2(EE(1,1,k),auxmat(1,1))
8119 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8120 vv(1)=pizda(1,1)+pizda(2,2)
8121 vv(2)=pizda(2,1)-pizda(1,2)
8122 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8123 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8124 cd & "sum",-(s2+s3+s4)
8126 eello6_graph3=-(s1+s2+s3+s4)
8128 eello6_graph3=-(s2+s3+s4)
8131 C Derivatives in gamma(k-1)
8133 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8134 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8135 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8136 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8137 C Derivatives in gamma(l-1)
8138 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8139 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8140 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8141 vv(1)=pizda(1,1)+pizda(2,2)
8142 vv(2)=pizda(2,1)-pizda(1,2)
8143 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8144 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8145 C Cartesian derivatives.
8151 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8153 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8156 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8158 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8159 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8161 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8162 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8164 vv(1)=pizda(1,1)+pizda(2,2)
8165 vv(2)=pizda(2,1)-pizda(1,2)
8166 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8168 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8170 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8173 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8175 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8177 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8184 c----------------------------------------------------------------------------
8185 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8186 implicit real*8 (a-h,o-z)
8187 include 'DIMENSIONS'
8188 include 'COMMON.IOUNITS'
8189 include 'COMMON.CHAIN'
8190 include 'COMMON.DERIV'
8191 include 'COMMON.INTERACT'
8192 include 'COMMON.CONTACTS'
8193 include 'COMMON.TORSION'
8194 include 'COMMON.VAR'
8195 include 'COMMON.GEO'
8196 include 'COMMON.FFIELD'
8197 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8198 & auxvec1(2),auxmat1(2,2)
8200 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8202 C Parallel Antiparallel C
8208 C \ j|/k\| \ |/k\|l C
8213 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8215 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8216 C energy moment and not to the cluster cumulant.
8217 cd write (2,*) 'eello_graph4: wturn6',wturn6
8218 iti=itype2loc(itype(i))
8219 itj=itype2loc(itype(j))
8220 if (j.lt.nres-1) then
8221 itj1=itype2loc(itype(j+1))
8225 itk=itype2loc(itype(k))
8226 if (k.lt.nres-1) then
8227 itk1=itype2loc(itype(k+1))
8231 itl=itype2loc(itype(l))
8232 if (l.lt.nres-1) then
8233 itl1=itype2loc(itype(l+1))
8237 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8238 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8239 cd & ' itl',itl,' itl1',itl1
8242 s1=dip(3,jj,i)*dip(3,kk,k)
8244 s1=dip(2,jj,j)*dip(2,kk,l)
8247 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8248 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8250 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8251 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8253 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8254 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8256 call transpose2(EUg(1,1,k),auxmat(1,1))
8257 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8258 vv(1)=pizda(1,1)-pizda(2,2)
8259 vv(2)=pizda(2,1)+pizda(1,2)
8260 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8261 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8263 eello6_graph4=-(s1+s2+s3+s4)
8265 eello6_graph4=-(s2+s3+s4)
8267 C Derivatives in gamma(i-1)
8272 s1=dipderg(2,jj,i)*dip(3,kk,k)
8274 s1=dipderg(4,jj,j)*dip(2,kk,l)
8277 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8279 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8280 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8282 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8283 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8285 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8286 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8287 cd write (2,*) 'turn6 derivatives'
8289 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8291 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8295 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8297 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8301 C Derivatives in gamma(k-1)
8304 s1=dip(3,jj,i)*dipderg(2,kk,k)
8306 s1=dip(2,jj,j)*dipderg(4,kk,l)
8309 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8310 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8312 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8313 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8315 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8316 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8318 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8319 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8320 vv(1)=pizda(1,1)-pizda(2,2)
8321 vv(2)=pizda(2,1)+pizda(1,2)
8322 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8323 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8325 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8327 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8331 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8333 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8336 C Derivatives in gamma(j-1) or gamma(l-1)
8337 if (l.eq.j+1 .and. l.gt.1) then
8338 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8339 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8340 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8341 vv(1)=pizda(1,1)-pizda(2,2)
8342 vv(2)=pizda(2,1)+pizda(1,2)
8343 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8344 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8345 else if (j.gt.1) then
8346 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8347 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8348 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8349 vv(1)=pizda(1,1)-pizda(2,2)
8350 vv(2)=pizda(2,1)+pizda(1,2)
8351 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8352 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8353 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8355 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8358 C Cartesian derivatives.
8365 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8367 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8371 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8373 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8377 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8379 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8381 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8382 & b1(1,j+1),auxvec(1))
8383 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8385 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8386 & b1(1,l+1),auxvec(1))
8387 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8389 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8391 vv(1)=pizda(1,1)-pizda(2,2)
8392 vv(2)=pizda(2,1)+pizda(1,2)
8393 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8395 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8397 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8400 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8403 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8406 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8408 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8410 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8414 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8416 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8419 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8421 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8430 c----------------------------------------------------------------------------
8431 double precision function eello_turn6(i,jj,kk)
8432 implicit real*8 (a-h,o-z)
8433 include 'DIMENSIONS'
8434 include 'COMMON.IOUNITS'
8435 include 'COMMON.CHAIN'
8436 include 'COMMON.DERIV'
8437 include 'COMMON.INTERACT'
8438 include 'COMMON.CONTACTS'
8439 include 'COMMON.TORSION'
8440 include 'COMMON.VAR'
8441 include 'COMMON.GEO'
8442 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8443 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8445 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8446 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8447 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8448 C the respective energy moment and not to the cluster cumulant.
8457 iti=itype2loc(itype(i))
8458 itk=itype2loc(itype(k))
8459 itk1=itype2loc(itype(k+1))
8460 itl=itype2loc(itype(l))
8461 itj=itype2loc(itype(j))
8462 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8463 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8464 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8469 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8471 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8475 derx_turn(lll,kkk,iii)=0.0d0
8482 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8484 cd write (2,*) 'eello6_5',eello6_5
8486 call transpose2(AEA(1,1,1),auxmat(1,1))
8487 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8488 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8489 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8491 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8492 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8493 s2 = scalar2(b1(1,k),vtemp1(1))
8495 call transpose2(AEA(1,1,2),atemp(1,1))
8496 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8497 call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1))
8498 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8500 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8501 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8502 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8504 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8505 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8506 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8507 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8508 ss13 = scalar2(b1(1,k),vtemp4(1))
8509 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8511 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8517 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8518 C Derivatives in gamma(i+2)
8523 call transpose2(AEA(1,1,1),auxmatd(1,1))
8524 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8525 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8526 call transpose2(AEAderg(1,1,2),atempd(1,1))
8527 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8528 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8530 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8531 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8532 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8538 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8539 C Derivatives in gamma(i+3)
8541 call transpose2(AEA(1,1,1),auxmatd(1,1))
8542 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8543 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8544 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8546 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8547 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8548 s2d = scalar2(b1(1,k),vtemp1d(1))
8550 call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1))
8551 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1))
8553 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8555 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8556 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8557 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8565 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8566 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8568 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8569 & -0.5d0*ekont*(s2d+s12d)
8571 C Derivatives in gamma(i+4)
8572 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8573 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8574 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8576 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8577 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8578 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8586 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8588 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8590 C Derivatives in gamma(i+5)
8592 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8593 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8594 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8596 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8597 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8598 s2d = scalar2(b1(1,k),vtemp1d(1))
8600 call transpose2(AEA(1,1,2),atempd(1,1))
8601 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8602 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1))
8604 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8605 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8607 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8608 ss13d = scalar2(b1(1,k),vtemp4d(1))
8609 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8617 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8618 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8620 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8621 & -0.5d0*ekont*(s2d+s12d)
8623 C Cartesian derivatives
8628 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8629 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8630 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8632 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8633 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8635 s2d = scalar2(b1(1,k),vtemp1d(1))
8637 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8638 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8639 s8d = -(atempd(1,1)+atempd(2,2))*
8640 & scalar2(cc(1,1,l),vtemp2(1))
8642 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8644 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8645 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8652 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8655 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8659 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8660 & - 0.5d0*(s8d+s12d)
8662 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8671 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8673 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8674 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8675 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8676 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8677 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8679 ss13d = scalar2(b1(1,k),vtemp4d(1))
8680 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8681 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8685 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8686 cd & 16*eel_turn6_num
8688 if (j.lt.nres-1) then
8695 if (l.lt.nres-1) then
8703 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8704 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8705 cgrad ghalf=0.5d0*ggg1(ll)
8707 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8708 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8709 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8710 & +ekont*derx_turn(ll,2,1)
8711 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8712 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8713 & +ekont*derx_turn(ll,4,1)
8714 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8715 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8716 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8717 cgrad ghalf=0.5d0*ggg2(ll)
8719 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8720 & +ekont*derx_turn(ll,2,2)
8721 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8722 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8723 & +ekont*derx_turn(ll,4,2)
8724 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8725 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8726 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8731 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8736 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8742 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8747 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8751 cd write (2,*) iii,g_corr6_loc(iii)
8754 eello_turn6=ekont*eel_turn6
8755 cd write (2,*) 'ekont',ekont
8756 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8760 crc-------------------------------------------------
8761 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8762 subroutine Eliptransfer(eliptran)
8763 implicit real*8 (a-h,o-z)
8764 include 'DIMENSIONS'
8765 include 'COMMON.GEO'
8766 include 'COMMON.VAR'
8767 include 'COMMON.LOCAL'
8768 include 'COMMON.CHAIN'
8769 include 'COMMON.DERIV'
8770 include 'COMMON.INTERACT'
8771 include 'COMMON.IOUNITS'
8772 include 'COMMON.CALC'
8773 include 'COMMON.CONTROL'
8774 include 'COMMON.SPLITELE'
8775 include 'COMMON.SBRIDGE'
8776 C this is done by Adasko
8780 C--bordliptop-- buffore starts
8781 C--bufliptop--- here true lipid starts
8783 C--buflipbot--- lipid ends buffore starts
8784 C--bordlipbot--buffore ends
8788 if (itype(i).eq.ntyp1) cycle
8790 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8791 if (positi.le.0) positi=positi+boxzsize
8793 C first for peptide groups
8794 c for each residue check if it is in lipid or lipid water border area
8795 if ((positi.gt.bordlipbot)
8796 &.and.(positi.lt.bordliptop)) then
8797 C the energy transfer exist
8798 if (positi.lt.buflipbot) then
8799 C what fraction I am in
8801 & ((positi-bordlipbot)/lipbufthick)
8802 C lipbufthick is thickenes of lipid buffore
8803 sslip=sscalelip(fracinbuf)
8804 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8805 eliptran=eliptran+sslip*pepliptran
8806 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8807 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8808 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8809 elseif (positi.gt.bufliptop) then
8810 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8811 sslip=sscalelip(fracinbuf)
8812 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8813 eliptran=eliptran+sslip*pepliptran
8814 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8815 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8816 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8817 C print *, "doing sscalefor top part"
8818 C print *,i,sslip,fracinbuf,ssgradlip
8820 eliptran=eliptran+pepliptran
8821 C print *,"I am in true lipid"
8824 C eliptran=elpitran+0.0 ! I am in water
8827 C print *, "nic nie bylo w lipidzie?"
8828 C now multiply all by the peptide group transfer factor
8829 C eliptran=eliptran*pepliptran
8830 C now the same for side chains
8833 if (itype(i).eq.ntyp1) cycle
8834 positi=(mod(c(3,i+nres),boxzsize))
8835 if (positi.le.0) positi=positi+boxzsize
8836 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8837 c for each residue check if it is in lipid or lipid water border area
8838 C respos=mod(c(3,i+nres),boxzsize)
8839 C print *,positi,bordlipbot,buflipbot
8840 if ((positi.gt.bordlipbot)
8841 & .and.(positi.lt.bordliptop)) then
8842 C the energy transfer exist
8843 if (positi.lt.buflipbot) then
8845 & ((positi-bordlipbot)/lipbufthick)
8846 C lipbufthick is thickenes of lipid buffore
8847 sslip=sscalelip(fracinbuf)
8848 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8849 eliptran=eliptran+sslip*liptranene(itype(i))
8850 gliptranx(3,i)=gliptranx(3,i)
8851 &+ssgradlip*liptranene(itype(i))
8852 gliptranc(3,i-1)= gliptranc(3,i-1)
8853 &+ssgradlip*liptranene(itype(i))
8854 C print *,"doing sccale for lower part"
8855 elseif (positi.gt.bufliptop) then
8857 &((bordliptop-positi)/lipbufthick)
8858 sslip=sscalelip(fracinbuf)
8859 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8860 eliptran=eliptran+sslip*liptranene(itype(i))
8861 gliptranx(3,i)=gliptranx(3,i)
8862 &+ssgradlip*liptranene(itype(i))
8863 gliptranc(3,i-1)= gliptranc(3,i-1)
8864 &+ssgradlip*liptranene(itype(i))
8865 C print *, "doing sscalefor top part",sslip,fracinbuf
8867 eliptran=eliptran+liptranene(itype(i))
8868 C print *,"I am in true lipid"
8870 endif ! if in lipid or buffor
8872 C eliptran=elpitran+0.0 ! I am in water
8878 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8880 SUBROUTINE MATVEC2(A1,V1,V2)
8881 implicit real*8 (a-h,o-z)
8882 include 'DIMENSIONS'
8883 DIMENSION A1(2,2),V1(2),V2(2)
8887 c 3 VI=VI+A1(I,K)*V1(K)
8891 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8892 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8897 C---------------------------------------
8898 SUBROUTINE MATMAT2(A1,A2,A3)
8899 implicit real*8 (a-h,o-z)
8900 include 'DIMENSIONS'
8901 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8902 c DIMENSION AI3(2,2)
8906 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8912 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8913 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8914 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8915 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8923 c-------------------------------------------------------------------------
8924 double precision function scalar2(u,v)
8926 double precision u(2),v(2)
8929 scalar2=u(1)*v(1)+u(2)*v(2)
8933 C-----------------------------------------------------------------------------
8935 subroutine transpose2(a,at)
8937 double precision a(2,2),at(2,2)
8944 c--------------------------------------------------------------------------
8945 subroutine transpose(n,a,at)
8948 double precision a(n,n),at(n,n)
8956 C---------------------------------------------------------------------------
8957 subroutine prodmat3(a1,a2,kk,transp,prod)
8960 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8962 crc double precision auxmat(2,2),prod_(2,2)
8965 crc call transpose2(kk(1,1),auxmat(1,1))
8966 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8967 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8969 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8970 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8971 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8972 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8973 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8974 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8975 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8976 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8979 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8980 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8982 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8983 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8984 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8985 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8986 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8987 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8988 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8989 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8992 c call transpose2(a2(1,1),a2t(1,1))
8995 crc print *,((prod_(i,j),i=1,2),j=1,2)
8996 crc print *,((prod(i,j),i=1,2),j=1,2)
9000 C-----------------------------------------------------------------------------
9001 double precision function scalar(u,v)
9003 double precision u(3),v(3)
9013 C-----------------------------------------------------------------------
9014 double precision function sscale(r)
9015 double precision r,gamm
9016 include "COMMON.SPLITELE"
9017 if(r.lt.r_cut-rlamb) then
9019 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9020 gamm=(r-(r_cut-rlamb))/rlamb
9021 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9027 C-----------------------------------------------------------------------
9028 C-----------------------------------------------------------------------
9029 double precision function sscagrad(r)
9030 double precision r,gamm
9031 include "COMMON.SPLITELE"
9032 if(r.lt.r_cut-rlamb) then
9034 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9035 gamm=(r-(r_cut-rlamb))/rlamb
9036 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
9042 C-----------------------------------------------------------------------
9043 C-----------------------------------------------------------------------
9044 double precision function sscalelip(r)
9045 double precision r,gamm
9046 include "COMMON.SPLITELE"
9047 C if(r.lt.r_cut-rlamb) then
9049 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9050 C gamm=(r-(r_cut-rlamb))/rlamb
9051 sscalelip=1.0d0+r*r*(2*r-3.0d0)
9057 C-----------------------------------------------------------------------
9058 double precision function sscagradlip(r)
9059 double precision r,gamm
9060 include "COMMON.SPLITELE"
9061 C if(r.lt.r_cut-rlamb) then
9063 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
9064 C gamm=(r-(r_cut-rlamb))/rlamb
9065 sscagradlip=r*(6*r-6.0d0)
9072 C-----------------------------------------------------------------------
9073 subroutine set_shield_fac
9074 implicit real*8 (a-h,o-z)
9075 include 'DIMENSIONS'
9076 include 'COMMON.CHAIN'
9077 include 'COMMON.DERIV'
9078 include 'COMMON.IOUNITS'
9079 include 'COMMON.SHIELD'
9080 include 'COMMON.INTERACT'
9081 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9082 double precision div77_81/0.974996043d0/,
9083 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9085 C the vector between center of side_chain and peptide group
9086 double precision pep_side(3),long,side_calf(3),
9087 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9088 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9089 C the line belowe needs to be changed for FGPROC>1
9091 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9093 Cif there two consequtive dummy atoms there is no peptide group between them
9094 C the line below has to be changed for FGPROC>1
9097 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9101 C first lets set vector conecting the ithe side-chain with kth side-chain
9102 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9104 C and vector conecting the side-chain with its proper calfa
9105 side_calf(j)=c(j,k+nres)-c(j,k)
9106 C side_calf(j)=2.0d0
9107 pept_group(j)=c(j,i)-c(j,i+1)
9108 C lets have their lenght
9109 dist_pep_side=pep_side(j)**2+dist_pep_side
9110 dist_side_calf=dist_side_calf+side_calf(j)**2
9111 dist_pept_group=dist_pept_group+pept_group(j)**2
9113 dist_pep_side=dsqrt(dist_pep_side)
9114 dist_pept_group=dsqrt(dist_pept_group)
9115 dist_side_calf=dsqrt(dist_side_calf)
9117 pep_side_norm(j)=pep_side(j)/dist_pep_side
9118 side_calf_norm(j)=dist_side_calf
9120 C now sscale fraction
9121 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9122 C print *,buff_shield,"buff"
9124 if (sh_frac_dist.le.0.0) cycle
9125 C If we reach here it means that this side chain reaches the shielding sphere
9126 C Lets add him to the list for gradient
9127 ishield_list(i)=ishield_list(i)+1
9128 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9129 C this list is essential otherwise problem would be O3
9130 shield_list(ishield_list(i),i)=k
9131 C Lets have the sscale value
9132 if (sh_frac_dist.gt.1.0) then
9133 scale_fac_dist=1.0d0
9135 sh_frac_dist_grad(j)=0.0d0
9138 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9139 & *(2.0*sh_frac_dist-3.0d0)
9140 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
9141 & /dist_pep_side/buff_shield*0.5
9142 C remember for the final gradient multiply sh_frac_dist_grad(j)
9143 C for side_chain by factor -2 !
9145 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9146 C print *,"jestem",scale_fac_dist,fac_help_scale,
9147 C & sh_frac_dist_grad(j)
9150 C if ((i.eq.3).and.(k.eq.2)) then
9151 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
9155 C this is what is now we have the distance scaling now volume...
9156 short=short_r_sidechain(itype(k))
9157 long=long_r_sidechain(itype(k))
9158 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9161 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9164 costhet_grad(j)=costhet_fac*pep_side(j)
9166 C remember for the final gradient multiply costhet_grad(j)
9167 C for side_chain by factor -2 !
9168 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9169 C pep_side0pept_group is vector multiplication
9170 pep_side0pept_group=0.0
9172 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9174 cosalfa=(pep_side0pept_group/
9175 & (dist_pep_side*dist_side_calf))
9176 fac_alfa_sin=1.0-cosalfa**2
9177 fac_alfa_sin=dsqrt(fac_alfa_sin)
9178 rkprim=fac_alfa_sin*(long-short)+short
9180 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9181 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9184 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9185 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9186 &*(long-short)/fac_alfa_sin*cosalfa/
9187 &((dist_pep_side*dist_side_calf))*
9188 &((side_calf(j))-cosalfa*
9189 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9191 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9192 &*(long-short)/fac_alfa_sin*cosalfa
9193 &/((dist_pep_side*dist_side_calf))*
9195 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9198 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9201 C now the gradient...
9202 C grad_shield is gradient of Calfa for peptide groups
9203 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9205 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9206 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9208 grad_shield(j,i)=grad_shield(j,i)
9209 C gradient po skalowaniu
9210 & +(sh_frac_dist_grad(j)
9211 C gradient po costhet
9212 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9213 &-scale_fac_dist*(cosphi_grad_long(j))
9214 &/(1.0-cosphi) )*div77_81
9216 C grad_shield_side is Cbeta sidechain gradient
9217 grad_shield_side(j,ishield_list(i),i)=
9218 & (sh_frac_dist_grad(j)*(-2.0d0)
9219 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9220 & +scale_fac_dist*(cosphi_grad_long(j))
9221 & *2.0d0/(1.0-cosphi))
9222 & *div77_81*VofOverlap
9224 grad_shield_loc(j,ishield_list(i),i)=
9225 & scale_fac_dist*cosphi_grad_loc(j)
9226 & *2.0d0/(1.0-cosphi)
9227 & *div77_81*VofOverlap
9229 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9231 fac_shield(i)=VolumeTotal*div77_81+div4_81
9232 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9236 C--------------------------------------------------------------------------
9237 C first for shielding is setting of function of side-chains
9238 subroutine set_shield_fac2
9239 implicit real*8 (a-h,o-z)
9240 include 'DIMENSIONS'
9241 include 'COMMON.CHAIN'
9242 include 'COMMON.DERIV'
9243 include 'COMMON.IOUNITS'
9244 include 'COMMON.SHIELD'
9245 include 'COMMON.INTERACT'
9246 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9247 double precision div77_81/0.974996043d0/,
9248 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9250 C the vector between center of side_chain and peptide group
9251 double precision pep_side(3),long,side_calf(3),
9252 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9253 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9254 C the line belowe needs to be changed for FGPROC>1
9256 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9258 Cif there two consequtive dummy atoms there is no peptide group between them
9259 C the line below has to be changed for FGPROC>1
9262 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9266 C first lets set vector conecting the ithe side-chain with kth side-chain
9267 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9269 C and vector conecting the side-chain with its proper calfa
9270 side_calf(j)=c(j,k+nres)-c(j,k)
9271 C side_calf(j)=2.0d0
9272 pept_group(j)=c(j,i)-c(j,i+1)
9273 C lets have their lenght
9274 dist_pep_side=pep_side(j)**2+dist_pep_side
9275 dist_side_calf=dist_side_calf+side_calf(j)**2
9276 dist_pept_group=dist_pept_group+pept_group(j)**2
9278 dist_pep_side=dsqrt(dist_pep_side)
9279 dist_pept_group=dsqrt(dist_pept_group)
9280 dist_side_calf=dsqrt(dist_side_calf)
9282 pep_side_norm(j)=pep_side(j)/dist_pep_side
9283 side_calf_norm(j)=dist_side_calf
9285 C now sscale fraction
9286 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9287 C print *,buff_shield,"buff"
9289 if (sh_frac_dist.le.0.0) cycle
9290 C If we reach here it means that this side chain reaches the shielding sphere
9291 C Lets add him to the list for gradient
9292 ishield_list(i)=ishield_list(i)+1
9293 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9294 C this list is essential otherwise problem would be O3
9295 shield_list(ishield_list(i),i)=k
9296 C Lets have the sscale value
9297 if (sh_frac_dist.gt.1.0) then
9298 scale_fac_dist=1.0d0
9300 sh_frac_dist_grad(j)=0.0d0
9303 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9304 & *(2.0d0*sh_frac_dist-3.0d0)
9305 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9306 & /dist_pep_side/buff_shield*0.5d0
9307 C remember for the final gradient multiply sh_frac_dist_grad(j)
9308 C for side_chain by factor -2 !
9310 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9311 C sh_frac_dist_grad(j)=0.0d0
9312 C scale_fac_dist=1.0d0
9313 C print *,"jestem",scale_fac_dist,fac_help_scale,
9314 C & sh_frac_dist_grad(j)
9317 C this is what is now we have the distance scaling now volume...
9318 short=short_r_sidechain(itype(k))
9319 long=long_r_sidechain(itype(k))
9320 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9321 sinthet=short/dist_pep_side*costhet
9325 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9326 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9327 C & -short/dist_pep_side**2/costhet)
9330 costhet_grad(j)=costhet_fac*pep_side(j)
9332 C remember for the final gradient multiply costhet_grad(j)
9333 C for side_chain by factor -2 !
9334 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9335 C pep_side0pept_group is vector multiplication
9336 pep_side0pept_group=0.0d0
9338 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9340 cosalfa=(pep_side0pept_group/
9341 & (dist_pep_side*dist_side_calf))
9342 fac_alfa_sin=1.0d0-cosalfa**2
9343 fac_alfa_sin=dsqrt(fac_alfa_sin)
9344 rkprim=fac_alfa_sin*(long-short)+short
9348 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9350 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9351 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9355 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9356 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9357 &*(long-short)/fac_alfa_sin*cosalfa/
9358 &((dist_pep_side*dist_side_calf))*
9359 &((side_calf(j))-cosalfa*
9360 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9361 C cosphi_grad_long(j)=0.0d0
9362 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9363 &*(long-short)/fac_alfa_sin*cosalfa
9364 &/((dist_pep_side*dist_side_calf))*
9366 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9367 C cosphi_grad_loc(j)=0.0d0
9369 C print *,sinphi,sinthet
9370 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9373 C now the gradient...
9375 grad_shield(j,i)=grad_shield(j,i)
9376 C gradient po skalowaniu
9377 & +(sh_frac_dist_grad(j)*VofOverlap
9378 C gradient po costhet
9379 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9380 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9381 & sinphi/sinthet*costhet*costhet_grad(j)
9382 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9384 C grad_shield_side is Cbeta sidechain gradient
9385 grad_shield_side(j,ishield_list(i),i)=
9386 & (sh_frac_dist_grad(j)*(-2.0d0)
9388 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9389 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9390 & sinphi/sinthet*costhet*costhet_grad(j)
9391 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9394 grad_shield_loc(j,ishield_list(i),i)=
9395 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9396 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9397 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9401 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9403 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9404 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9405 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9409 C--------------------------------------------------------------------------
9410 double precision function tschebyshev(m,n,x,y)
9412 include "DIMENSIONS"
9414 double precision x(n),y,yy(0:maxvar),aux
9415 c Tschebyshev polynomial. Note that the first term is omitted
9416 c m=0: the constant term is included
9417 c m=1: the constant term is not included
9421 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
9430 C--------------------------------------------------------------------------
9431 double precision function gradtschebyshev(m,n,x,y)
9433 include "DIMENSIONS"
9435 double precision x(n+1),y,yy(0:maxvar),aux
9436 c Tschebyshev polynomial. Note that the first term is omitted
9437 c m=0: the constant term is included
9438 c m=1: the constant term is not included
9442 yy(i)=2*y*yy(i-1)-yy(i-2)
9446 aux=aux+x(i+1)*yy(i)*(i+1)
9447 C print *, x(i+1),yy(i),i
9452 c----------------------------------------------------------------------------
9453 double precision function sscale2(r,r_cut,r0,rlamb)
9455 double precision r,gamm,r_cut,r0,rlamb,rr
9457 c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb
9458 c write (2,*) "rr",rr
9459 if(rr.lt.r_cut-rlamb) then
9461 else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then
9462 gamm=(rr-(r_cut-rlamb))/rlamb
9463 sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0)
9469 C-----------------------------------------------------------------------
9470 double precision function sscalgrad2(r,r_cut,r0,rlamb)
9472 double precision r,gamm,r_cut,r0,rlamb,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
9479 sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb
9481 sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb
9488 c----------------------------------------------------------------------------
9489 subroutine e_saxs(Esaxs_constr)
9491 include 'DIMENSIONS'
9494 include "COMMON.SETUP"
9497 include 'COMMON.SBRIDGE'
9498 include 'COMMON.CHAIN'
9499 include 'COMMON.GEO'
9500 include 'COMMON.LOCAL'
9501 include 'COMMON.INTERACT'
9502 include 'COMMON.VAR'
9503 include 'COMMON.IOUNITS'
9504 include 'COMMON.DERIV'
9505 include 'COMMON.CONTROL'
9506 include 'COMMON.NAMES'
9507 include 'COMMON.FFIELD'
9508 include 'COMMON.LANGEVIN'
9510 double precision Esaxs_constr
9511 integer i,iint,j,k,l
9512 double precision PgradC(maxSAXS,3,maxres),
9513 & PgradX(maxSAXS,3,maxres)
9515 double precision PgradC_(maxSAXS,3,maxres),
9516 & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS)
9518 double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC,
9519 & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC,
9520 & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1,
9521 & auxX,auxX1,CACAgrad,Cnorm
9522 double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2
9523 double precision dist
9525 c SAXS restraint penalty function
9527 write(iout,*) "------- SAXS penalty function start -------"
9528 write (iout,*) "nsaxs",nsaxs
9529 write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e
9530 write (iout,*) "Psaxs"
9532 write (iout,'(i5,e15.5)') i, Psaxs(i)
9535 Esaxs_constr = 0.0d0
9545 do i=iatsc_s,iatsc_e
9546 if (itype(i).eq.ntyp1) cycle
9547 do iint=1,nint_gr(i)
9548 do j=istart(i,iint),iend(i,iint)
9549 if (itype(j).eq.ntyp1) cycle
9552 dijCASC=dist(i,j+nres)
9553 dijSCCA=dist(i+nres,j)
9554 dijSCSC=dist(i+nres,j+nres)
9555 sigma2CACA=2.0d0/(pstok**2)
9556 sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2)
9557 sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2)
9558 sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2)
9561 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9562 if (itype(j).ne.10) then
9563 expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2)
9567 if (itype(i).ne.10) then
9568 expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2)
9572 if (itype(i).ne.10 .and. itype(j).ne.10) then
9573 expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2)
9577 Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC
9579 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9581 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9582 CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC
9583 SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA
9584 SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC
9587 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9588 PgradC(k,l,i) = PgradC(k,l,i)-aux
9589 PgradC(k,l,j) = PgradC(k,l,j)+aux
9591 if (itype(j).ne.10) then
9592 aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC
9593 PgradC(k,l,i) = PgradC(k,l,i)-aux
9594 PgradC(k,l,j) = PgradC(k,l,j)+aux
9595 PgradX(k,l,j) = PgradX(k,l,j)+aux
9598 if (itype(i).ne.10) then
9599 aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA
9600 PgradX(k,l,i) = PgradX(k,l,i)-aux
9601 PgradC(k,l,i) = PgradC(k,l,i)-aux
9602 PgradC(k,l,j) = PgradC(k,l,j)+aux
9605 if (itype(i).ne.10 .and. itype(j).ne.10) then
9606 aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC
9607 PgradC(k,l,i) = PgradC(k,l,i)-aux
9608 PgradC(k,l,j) = PgradC(k,l,j)+aux
9609 PgradX(k,l,i) = PgradX(k,l,i)-aux
9610 PgradX(k,l,j) = PgradX(k,l,j)+aux
9616 sigma2CACA=scal_rad**2*0.25d0/
9617 & (restok(itype(j))**2+restok(itype(i))**2)
9619 IF (saxs_cutoff.eq.0) THEN
9622 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)
9623 Pcalc(k) = Pcalc(k)+expCACA
9624 CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA
9626 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9627 PgradC(k,l,i) = PgradC(k,l,i)-aux
9628 PgradC(k,l,j) = PgradC(k,l,j)+aux
9632 rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA)
9635 c write (2,*) "ijk",i,j,k
9636 sss2 = sscale2(dijCACA,rrr,dk,0.3d0)
9637 if (sss2.eq.0.0d0) cycle
9638 ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0)
9639 expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2
9640 Pcalc(k) = Pcalc(k)+expCACA
9642 write(iout,*) "i j k Pcalc",i,j,Pcalc(k)
9644 CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+
9645 & ssgrad2*expCACA/sss2
9648 aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA
9649 PgradC(k,l,i) = PgradC(k,l,i)+aux
9650 PgradC(k,l,j) = PgradC(k,l,j)-aux
9659 if (nfgtasks.gt.1) then
9660 call MPI_Reduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION,
9661 & MPI_SUM,king,FG_COMM,IERR)
9662 if (fg_rank.eq.king) then
9664 Pcalc(k) = Pcalc_(k)
9667 call MPI_Reduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres,
9668 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9669 if (fg_rank.eq.king) then
9673 PgradC(k,l,i) = PgradC_(k,l,i)
9679 call MPI_Reduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres,
9680 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9681 if (fg_rank.eq.king) then
9685 PgradX(k,l,i) = PgradX_(k,l,i)
9694 if (fg_rank.eq.king) then
9698 Cnorm = Cnorm + Pcalc(k)
9700 Esaxs_constr = dlog(Cnorm)-wsaxs0
9702 if (Pcalc(k).gt.0.0d0)
9703 & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k))
9705 write (iout,*) "k",k," Esaxs_constr",Esaxs_constr
9709 write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr
9719 & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k)
9720 auxC1 = auxC1+PgradC(k,l,i)
9722 auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k)
9723 auxX1 = auxX1+PgradX(k,l,i)
9726 gsaxsC(l,i) = auxC - auxC1/Cnorm
9728 gsaxsX(l,i) = auxX - auxX1/Cnorm
9730 c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm),
9731 c * " gradX",wsaxs*(auxX - auxX1/Cnorm)
9739 c----------------------------------------------------------------------------
9740 subroutine e_saxsC(Esaxs_constr)
9742 include 'DIMENSIONS'
9745 include "COMMON.SETUP"
9748 include 'COMMON.SBRIDGE'
9749 include 'COMMON.CHAIN'
9750 include 'COMMON.GEO'
9751 include 'COMMON.LOCAL'
9752 include 'COMMON.INTERACT'
9753 include 'COMMON.VAR'
9754 include 'COMMON.IOUNITS'
9755 include 'COMMON.DERIV'
9756 include 'COMMON.CONTROL'
9757 include 'COMMON.NAMES'
9758 include 'COMMON.FFIELD'
9759 include 'COMMON.LANGEVIN'
9761 double precision Esaxs_constr
9762 integer i,iint,j,k,l
9763 double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc_,logPtot
9765 double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_
9767 double precision dk,dijCASPH,dijSCSPH,
9768 & sigma2CA,sigma2SC,expCASPH,expSCSPH,
9769 & CASPHgrad,SCSPHgrad,aux,auxC,auxC1,
9771 c SAXS restraint penalty function
9773 write(iout,*) "------- SAXS penalty function start -------"
9774 write (iout,*) "nsaxs",nsaxs," isaxs_start",isaxs_start,
9775 & " isaxs_end",isaxs_end
9776 write (iout,*) "nnt",nnt," ntc",nct
9778 write(iout,'(a6,i5,3f10.5,5x,2f10.5)')
9779 & "CA",i,(C(j,i),j=1,3),pstok,restok(itype(i))
9782 write(iout,'(a6,i5,3f10.5)')"CSaxs",i,(Csaxs(j,i),j=1,3)
9785 Esaxs_constr = 0.0d0
9787 do j=isaxs_start,isaxs_end
9799 dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2
9801 if (itype(i).ne.10) then
9803 dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2
9806 sigma2CA=2.0d0/pstok**2
9807 sigma2SC=4.0d0/restok(itype(i))**2
9808 expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH)
9809 expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH)
9810 Pcalc_ = Pcalc_+expCASPH+expSCSPH
9812 write(*,*) "processor i j Pcalc",
9813 & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc_
9815 CASPHgrad = sigma2CA*expCASPH
9816 SCSPHgrad = sigma2SC*expSCSPH
9818 aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad
9819 PgradX(l,i) = PgradX(l,i) + aux
9820 PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux
9825 gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc_
9826 gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc_
9829 logPtot = logPtot - dlog(Pcalc_)
9830 c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc_),
9831 c & " logPtot",logPtot
9834 if (nfgtasks.gt.1) then
9835 c write (iout,*) "logPtot before reduction",logPtot
9836 call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION,
9837 & MPI_SUM,king,FG_COMM,IERR)
9839 c write (iout,*) "logPtot after reduction",logPtot
9840 call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres,
9841 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9842 if (fg_rank.eq.king) then
9845 gsaxsC(l,i) = gsaxsC_(l,i)
9849 call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres,
9850 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
9851 if (fg_rank.eq.king) then
9854 gsaxsX(l,i) = gsaxsX_(l,i)
9860 Esaxs_constr = logPtot