1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 include 'COMMON.SHIELD'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
49 C write(iout,*) 'po elektostatyce'
51 C Calculate electrostatic (H-bonding) energy of the main chain.
54 if (shield_mode.eq.1) then
56 else if (shield_mode.eq.2) then
59 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
60 C write(iout,*) 'po eelec'
62 C Calculate excluded-volume interaction energy between peptide groups
65 call escp(evdw2,evdw2_14)
67 c Calculate the bond-stretching energy
71 C write (iout,*) "estr",estr
73 C Calculate the disulfide-bridge and other energy and the contributions
74 C from other distance constraints.
75 cd print *,'Calling EHPB'
77 cd print *,'EHPB exitted succesfully.'
79 C Calculate the virtual-bond-angle energy.
81 C print *,'Bend energy finished.'
82 call ebend(ebe,ethetacnstr)
83 cd print *,'Bend energy finished.'
85 C Calculate the SC local energy.
88 C print *,'SCLOC energy finished.'
90 C Calculate the virtual-bond torsional energy.
92 cd print *,'nterm=',nterm
93 call etor(etors,edihcnstr,fact(1))
95 C 6/23/01 Calculate double-torsional energy
97 call etor_d(etors_d,fact(2))
99 C 21/5/07 Calculate local sicdechain correlation energy
101 call eback_sc_corr(esccor)
103 if (wliptran.gt.0) then
104 call Eliptransfer(eliptran)
107 if (TUBElog.eq.1) then
108 print *,"just before call"
110 print *,"just after call",etube
111 elseif (TUBElog.eq.2) then
112 call calctube2(Etube)
113 elseif (TUBElog.eq.3) then
120 C 12/1/95 Multi-body terms
124 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
125 & .or. wturn6.gt.0.0d0) then
126 c print *,"calling multibody_eello"
127 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
128 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
129 c print *,ecorr,ecorr5,ecorr6,eturn6
136 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
137 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
139 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
141 if (shield_mode.gt.0) then
142 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
144 & +fact(1)*wvdwpp*evdw1
145 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
146 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
147 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
148 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
149 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
150 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
151 & +wliptran*eliptran+wtube*Etube
153 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
155 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
156 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
157 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
158 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
159 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
160 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
161 & +wliptran*eliptran+wtube*Etube
164 if (shield_mode.gt.0) then
165 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
166 & +welec*fact(1)*(ees+evdw1)
167 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
168 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
169 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
170 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
171 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
172 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
173 & +wliptran*eliptran+wtube*Etube
175 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
176 & +welec*fact(1)*(ees+evdw1)
177 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
178 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
179 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
180 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
181 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
182 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
183 & +wliptran*eliptran+wtube*Etube
189 energia(2)=evdw2-evdw2_14
206 energia(8)=eello_turn3
207 energia(9)=eello_turn4
216 energia(20)=edihcnstr
218 energia(24)=ethetacnstr
224 if (isnan(etot).ne.0) energia(0)=1.0d+99
226 if (isnan(etot)) energia(0)=1.0d+99
231 idumm=proc_proc(etot,i)
233 call proc_proc(etot,i)
235 if(i.eq.1)energia(0)=1.0d+99
242 call enerprint(energia,fact)
247 C Sum up the components of the Cartesian gradient.
252 if (shield_mode.eq.0) then
253 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
254 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
256 & wstrain*ghpbc(j,i)+
257 & wcorr*fact(3)*gradcorr(j,i)+
258 & wel_loc*fact(2)*gel_loc(j,i)+
259 & wturn3*fact(2)*gcorr3_turn(j,i)+
260 & wturn4*fact(3)*gcorr4_turn(j,i)+
261 & wcorr5*fact(4)*gradcorr5(j,i)+
262 & wcorr6*fact(5)*gradcorr6(j,i)+
263 & wturn6*fact(5)*gcorr6_turn(j,i)+
264 & wsccor*fact(2)*gsccorc(j,i)
265 & +wliptran*gliptranc(j,i)
266 & +welec*gshieldc(j,i)
267 & +welec*gshieldc_loc(j,i)
268 & +wcorr*gshieldc_ec(j,i)
269 & +wcorr*gshieldc_loc_ec(j,i)
270 & +wturn3*gshieldc_t3(j,i)
271 & +wturn3*gshieldc_loc_t3(j,i)
272 & +wturn4*gshieldc_t4(j,i)
273 & +wturn4*gshieldc_loc_t4(j,i)
274 & +wel_loc*gshieldc_ll(j,i)
275 & +wel_loc*gshieldc_loc_ll(j,i)
276 & +wtube*gg_tube(j,i)
279 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
281 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
282 & wsccor*fact(2)*gsccorx(j,i)
283 & +wliptran*gliptranx(j,i)
284 & +welec*gshieldx(j,i)
285 & +wcorr*gshieldx_ec(j,i)
286 & +wturn3*gshieldx_t3(j,i)
287 & +wturn4*gshieldx_t4(j,i)
288 & +wel_loc*gshieldx_ll(j,i)
289 & +wtube*gg_tube_SC(j,i)
292 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
293 & +fact(1)*wscp*gvdwc_scp(j,i)+
294 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
296 & wstrain*ghpbc(j,i)+
297 & wcorr*fact(3)*gradcorr(j,i)+
298 & wel_loc*fact(2)*gel_loc(j,i)+
299 & wturn3*fact(2)*gcorr3_turn(j,i)+
300 & wturn4*fact(3)*gcorr4_turn(j,i)+
301 & wcorr5*fact(4)*gradcorr5(j,i)+
302 & wcorr6*fact(5)*gradcorr6(j,i)+
303 & wturn6*fact(5)*gcorr6_turn(j,i)+
304 & wsccor*fact(2)*gsccorc(j,i)
305 & +wliptran*gliptranc(j,i)
306 & +welec*gshieldc(j,i)
307 & +welec*gshieldc_loc(j,i)
308 & +wcorr*gshieldc_ec(j,i)
309 & +wcorr*gshieldc_loc_ec(j,i)
310 & +wturn3*gshieldc_t3(j,i)
311 & +wturn3*gshieldc_loc_t3(j,i)
312 & +wturn4*gshieldc_t4(j,i)
313 & +wturn4*gshieldc_loc_t4(j,i)
314 & +wel_loc*gshieldc_ll(j,i)
315 & +wel_loc*gshieldc_loc_ll(j,i)
316 & +wtube*gg_tube(j,i)
319 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
320 & +fact(1)*wscp*gradx_scp(j,i)+
322 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
323 & wsccor*fact(2)*gsccorx(j,i)
324 & +wliptran*gliptranx(j,i)
325 & +welec*gshieldx(j,i)
326 & +wcorr*gshieldx_ec(j,i)
327 & +wturn3*gshieldx_t3(j,i)
328 & +wturn4*gshieldx_t4(j,i)
329 & +wel_loc*gshieldx_ll(j,i)
330 & +wtube*gg_tube_SC(j,i)
338 if (shield_mode.eq.0) then
339 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
340 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
342 & wcorr*fact(3)*gradcorr(j,i)+
343 & wel_loc*fact(2)*gel_loc(j,i)+
344 & wturn3*fact(2)*gcorr3_turn(j,i)+
345 & wturn4*fact(3)*gcorr4_turn(j,i)+
346 & wcorr5*fact(4)*gradcorr5(j,i)+
347 & wcorr6*fact(5)*gradcorr6(j,i)+
348 & wturn6*fact(5)*gcorr6_turn(j,i)+
349 & wsccor*fact(2)*gsccorc(j,i)
350 & +wliptran*gliptranc(j,i)
351 & +welec*gshieldc(j,i)
352 & +welec*gshieldc_loc(j,i)
353 & +wcorr*gshieldc_ec(j,i)
354 & +wcorr*gshieldc_loc_ec(j,i)
355 & +wturn3*gshieldc_t3(j,i)
356 & +wturn3*gshieldc_loc_t3(j,i)
357 & +wturn4*gshieldc_t4(j,i)
358 & +wturn4*gshieldc_loc_t4(j,i)
359 & +wel_loc*gshieldc_ll(j,i)
360 & +wel_loc*gshieldc_loc_ll(j,i)
361 & +wtube*gg_tube(j,i)
363 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
365 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
366 & wsccor*fact(1)*gsccorx(j,i)
367 & +wliptran*gliptranx(j,i)
368 & +welec*gshieldx(j,i)
369 & +wcorr*gshieldx_ec(j,i)
370 & +wturn3*gshieldx_t3(j,i)
371 & +wturn4*gshieldx_t4(j,i)
372 & +wel_loc*gshieldx_ll(j,i)
373 & +wtube*gg_tube_sc(j,i)
377 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
378 & fact(1)*wscp*gvdwc_scp(j,i)+
379 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
381 & wcorr*fact(3)*gradcorr(j,i)+
382 & wel_loc*fact(2)*gel_loc(j,i)+
383 & wturn3*fact(2)*gcorr3_turn(j,i)+
384 & wturn4*fact(3)*gcorr4_turn(j,i)+
385 & wcorr5*fact(4)*gradcorr5(j,i)+
386 & wcorr6*fact(5)*gradcorr6(j,i)+
387 & wturn6*fact(5)*gcorr6_turn(j,i)+
388 & wsccor*fact(2)*gsccorc(j,i)
389 & +wliptran*gliptranc(j,i)
390 & +welec*gshieldc(j,i)
391 & +welec*gshieldc_loc(j,i)
392 & +wcorr*gshieldc_ec(j,i)
393 & +wcorr*gshieldc_loc_ec(j,i)
394 & +wturn3*gshieldc_t3(j,i)
395 & +wturn3*gshieldc_loc_t3(j,i)
396 & +wturn4*gshieldc_t4(j,i)
397 & +wturn4*gshieldc_loc_t4(j,i)
398 & +wel_loc*gshieldc_ll(j,i)
399 & +wel_loc*gshieldc_loc_ll(j,i)
400 & +wtube*gg_tube(j,i)
402 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
403 & fact(1)*wscp*gradx_scp(j,i)+
405 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
406 & wsccor*fact(1)*gsccorx(j,i)
407 & +wliptran*gliptranx(j,i)
408 & +welec*gshieldx(j,i)
409 & +wcorr*gshieldx_ec(j,i)
410 & +wturn3*gshieldx_t3(j,i)
411 & +wturn4*gshieldx_t4(j,i)
412 & +wel_loc*gshieldx_ll(j,i)
413 & +wtube*gg_tube_sc(j,i)
423 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
424 & +wcorr5*fact(4)*g_corr5_loc(i)
425 & +wcorr6*fact(5)*g_corr6_loc(i)
426 & +wturn4*fact(3)*gel_loc_turn4(i)
427 & +wturn3*fact(2)*gel_loc_turn3(i)
428 & +wturn6*fact(5)*gel_loc_turn6(i)
429 & +wel_loc*fact(2)*gel_loc_loc(i)
430 c & +wsccor*fact(1)*gsccor_loc(i)
431 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
434 if (dyn_ss) call dyn_set_nss
437 C------------------------------------------------------------------------
438 subroutine enerprint(energia,fact)
439 implicit real*8 (a-h,o-z)
441 include 'DIMENSIONS.ZSCOPT'
442 include 'COMMON.IOUNITS'
443 include 'COMMON.FFIELD'
444 include 'COMMON.SBRIDGE'
445 double precision energia(0:max_ene),fact(6)
447 evdw=energia(1)+fact(6)*energia(21)
449 evdw2=energia(2)+energia(17)
461 eello_turn3=energia(8)
462 eello_turn4=energia(9)
463 eello_turn6=energia(10)
470 edihcnstr=energia(20)
472 ethetacnstr=energia(24)
476 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
478 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
479 & etors_d,wtor_d*fact(2),ehpb,wstrain,
480 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
481 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
482 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
483 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
484 & eliptran,wliptran,etube,wtube ,etot
485 10 format (/'Virtual-chain energies:'//
486 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
487 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
488 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
489 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
490 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
491 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
492 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
493 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
494 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
495 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
496 & ' (SS bridges & dist. cnstr.)'/
497 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
498 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
499 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
500 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
501 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
502 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
503 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
504 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
505 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
506 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
507 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
508 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
509 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
510 & 'ETOT= ',1pE16.6,' (total)')
512 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
513 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
514 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
515 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
516 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
517 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
518 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etube,wtube,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 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
524 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
525 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
526 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
527 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
528 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
529 & ' (SS bridges & dist. cnstr.)'/
530 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
531 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
532 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
533 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
534 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
535 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
536 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
537 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
538 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
539 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
540 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
541 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
542 & 'ETOT= ',1pE16.6,' (total)')
546 C-----------------------------------------------------------------------
547 subroutine elj(evdw,evdw_t)
549 C This subroutine calculates the interaction energy of nonbonded side chains
550 C assuming the LJ potential of interaction.
552 implicit real*8 (a-h,o-z)
554 include 'DIMENSIONS.ZSCOPT'
555 include "DIMENSIONS.COMPAR"
556 parameter (accur=1.0d-10)
559 include 'COMMON.LOCAL'
560 include 'COMMON.CHAIN'
561 include 'COMMON.DERIV'
562 include 'COMMON.INTERACT'
563 include 'COMMON.TORSION'
564 include 'COMMON.ENEPS'
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 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 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
616 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.ZSCOPT'
737 include "DIMENSIONS.COMPAR"
740 include 'COMMON.LOCAL'
741 include 'COMMON.CHAIN'
742 include 'COMMON.DERIV'
743 include 'COMMON.INTERACT'
744 include 'COMMON.ENEPS'
745 include 'COMMON.IOUNITS'
746 include 'COMMON.NAMES'
751 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
754 eneps_temp(j,i)=0.0d0
761 if (itypi.eq.ntyp1) cycle
762 itypi1=iabs(itype(i+1))
767 C Calculate SC interaction energy.
770 do j=istart(i,iint),iend(i,iint)
772 if (itypj.eq.ntyp1) cycle
776 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
778 e_augm=augm(itypi,itypj)*fac_augm
781 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
782 fac=r_shift_inv**expon
786 ij=icant(itypi,itypj)
787 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
788 & /dabs(eps(itypi,itypj))
789 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
790 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
791 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
792 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
793 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
794 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
795 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
796 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
797 if (bb.gt.0.0d0) then
804 C Calculate the components of the gradient in DC and X
806 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
811 gvdwx(k,i)=gvdwx(k,i)-gg(k)
812 gvdwx(k,j)=gvdwx(k,j)+gg(k)
816 gvdwc(l,k)=gvdwc(l,k)+gg(l)
826 gvdwc(j,i)=expon*gvdwc(j,i)
827 gvdwx(j,i)=expon*gvdwx(j,i)
833 C-----------------------------------------------------------------------------
834 subroutine ebp(evdw,evdw_t)
836 C This subroutine calculates the interaction energy of nonbonded side chains
837 C assuming the Berne-Pechukas potential of interaction.
839 implicit real*8 (a-h,o-z)
841 include 'DIMENSIONS.ZSCOPT'
842 include "DIMENSIONS.COMPAR"
845 include 'COMMON.LOCAL'
846 include 'COMMON.CHAIN'
847 include 'COMMON.DERIV'
848 include 'COMMON.NAMES'
849 include 'COMMON.INTERACT'
850 include 'COMMON.ENEPS'
851 include 'COMMON.IOUNITS'
852 include 'COMMON.CALC'
854 c double precision rrsave(maxdim)
860 eneps_temp(j,i)=0.0d0
865 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
866 c if (icall.eq.0) then
874 if (itypi.eq.ntyp1) cycle
875 itypi1=iabs(itype(i+1))
879 dxi=dc_norm(1,nres+i)
880 dyi=dc_norm(2,nres+i)
881 dzi=dc_norm(3,nres+i)
882 dsci_inv=vbld_inv(i+nres)
884 C Calculate SC interaction energy.
887 do j=istart(i,iint),iend(i,iint)
890 if (itypj.eq.ntyp1) cycle
891 dscj_inv=vbld_inv(j+nres)
892 chi1=chi(itypi,itypj)
893 chi2=chi(itypj,itypi)
900 alf12=0.5D0*(alf1+alf2)
901 C For diagnostics only!!!
914 dxj=dc_norm(1,nres+j)
915 dyj=dc_norm(2,nres+j)
916 dzj=dc_norm(3,nres+j)
917 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
918 cd if (icall.eq.0) then
924 C Calculate the angle-dependent terms of energy & contributions to derivatives.
926 C Calculate whole angle-dependent part of epsilon and contributions
928 fac=(rrij*sigsq)**expon2
931 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
932 eps2der=evdwij*eps3rt
933 eps3der=evdwij*eps2rt
934 evdwij=evdwij*eps2rt*eps3rt
935 ij=icant(itypi,itypj)
936 aux=eps1*eps2rt**2*eps3rt**2
937 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
938 & /dabs(eps(itypi,itypj))
939 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
940 if (bb.gt.0.0d0) then
947 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
949 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
950 & restyp(itypi),i,restyp(itypj),j,
951 & epsi,sigm,chi1,chi2,chip1,chip2,
952 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
953 & om1,om2,om12,1.0D0/dsqrt(rrij),
956 C Calculate gradient components.
957 e1=e1*eps1*eps2rt**2*eps3rt**2
958 fac=-expon*(e1+evdwij)
961 C Calculate radial part of the gradient
965 C Calculate the angular part of the gradient and sum add the contributions
966 C to the appropriate components of the Cartesian gradient.
975 C-----------------------------------------------------------------------------
976 subroutine egb(evdw,evdw_t)
978 C This subroutine calculates the interaction energy of nonbonded side chains
979 C assuming the Gay-Berne potential of interaction.
981 implicit real*8 (a-h,o-z)
983 include 'DIMENSIONS.ZSCOPT'
984 include "DIMENSIONS.COMPAR"
987 include 'COMMON.LOCAL'
988 include 'COMMON.CHAIN'
989 include 'COMMON.DERIV'
990 include 'COMMON.NAMES'
991 include 'COMMON.INTERACT'
992 include 'COMMON.ENEPS'
993 include 'COMMON.IOUNITS'
994 include 'COMMON.CALC'
995 include 'COMMON.SBRIDGE'
998 integer icant,xshift,yshift,zshift
1002 eneps_temp(j,i)=0.0d0
1005 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1009 c if (icall.gt.0) lprn=.true.
1011 do i=iatsc_s,iatsc_e
1012 itypi=iabs(itype(i))
1013 if (itypi.eq.ntyp1) cycle
1014 itypi1=iabs(itype(i+1))
1018 C returning the ith atom to box
1020 if (xi.lt.0) xi=xi+boxxsize
1022 if (yi.lt.0) yi=yi+boxysize
1024 if (zi.lt.0) zi=zi+boxzsize
1025 if ((zi.gt.bordlipbot)
1026 &.and.(zi.lt.bordliptop)) then
1027 C the energy transfer exist
1028 if (zi.lt.buflipbot) then
1029 C what fraction I am in
1031 & ((zi-bordlipbot)/lipbufthick)
1032 C lipbufthick is thickenes of lipid buffore
1033 sslipi=sscalelip(fracinbuf)
1034 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1035 elseif (zi.gt.bufliptop) then
1036 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1037 sslipi=sscalelip(fracinbuf)
1038 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1048 dxi=dc_norm(1,nres+i)
1049 dyi=dc_norm(2,nres+i)
1050 dzi=dc_norm(3,nres+i)
1051 dsci_inv=vbld_inv(i+nres)
1053 C Calculate SC interaction energy.
1055 do iint=1,nint_gr(i)
1056 do j=istart(i,iint),iend(i,iint)
1057 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1058 call dyn_ssbond_ene(i,j,evdwij)
1060 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1061 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1062 C triple bond artifac removal
1063 do k=j+1,iend(i,iint)
1064 C search over all next residues
1065 if (dyn_ss_mask(k)) then
1066 C check if they are cysteins
1067 C write(iout,*) 'k=',k
1068 call triple_ssbond_ene(i,j,k,evdwij)
1069 C call the energy function that removes the artifical triple disulfide
1070 C bond the soubroutine is located in ssMD.F
1072 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1073 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1074 endif!dyn_ss_mask(k)
1078 itypj=iabs(itype(j))
1079 if (itypj.eq.ntyp1) cycle
1080 dscj_inv=vbld_inv(j+nres)
1081 sig0ij=sigma(itypi,itypj)
1082 chi1=chi(itypi,itypj)
1083 chi2=chi(itypj,itypi)
1090 alf12=0.5D0*(alf1+alf2)
1091 C For diagnostics only!!!
1104 C returning jth atom to box
1106 if (xj.lt.0) xj=xj+boxxsize
1108 if (yj.lt.0) yj=yj+boxysize
1110 if (zj.lt.0) zj=zj+boxzsize
1111 if ((zj.gt.bordlipbot)
1112 &.and.(zj.lt.bordliptop)) then
1113 C the energy transfer exist
1114 if (zj.lt.buflipbot) then
1115 C what fraction I am in
1117 & ((zj-bordlipbot)/lipbufthick)
1118 C lipbufthick is thickenes of lipid buffore
1119 sslipj=sscalelip(fracinbuf)
1120 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1121 elseif (zj.gt.bufliptop) then
1122 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1123 sslipj=sscalelip(fracinbuf)
1124 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1133 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1134 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1135 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1136 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1137 C if (aa.ne.aa_aq(itypi,itypj)) then
1139 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1140 C & bb_aq(itypi,itypj)-bb,
1144 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1145 C checking the distance
1146 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1151 C finding the closest
1155 xj=xj_safe+xshift*boxxsize
1156 yj=yj_safe+yshift*boxysize
1157 zj=zj_safe+zshift*boxzsize
1158 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1159 if(dist_temp.lt.dist_init) then
1169 if (subchap.eq.1) then
1179 dxj=dc_norm(1,nres+j)
1180 dyj=dc_norm(2,nres+j)
1181 dzj=dc_norm(3,nres+j)
1182 c write (iout,*) i,j,xj,yj,zj
1183 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1185 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1186 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1187 if (sss.le.0.0) cycle
1188 C Calculate angle-dependent terms of energy and contributions to their
1193 sig=sig0ij*dsqrt(sigsq)
1194 rij_shift=1.0D0/rij-sig+sig0ij
1195 C I hate to put IF's in the loops, but here don't have another choice!!!!
1196 if (rij_shift.le.0.0D0) then
1201 c---------------------------------------------------------------
1202 rij_shift=1.0D0/rij_shift
1203 fac=rij_shift**expon
1206 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1207 eps2der=evdwij*eps3rt
1208 eps3der=evdwij*eps2rt
1209 evdwij=evdwij*eps2rt*eps3rt
1211 evdw=evdw+evdwij*sss
1213 evdw_t=evdw_t+evdwij*sss
1215 ij=icant(itypi,itypj)
1216 aux=eps1*eps2rt**2*eps3rt**2
1217 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1218 & /dabs(eps(itypi,itypj))
1219 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1220 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1221 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1222 c & aux*e2/eps(itypi,itypj)
1224 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1228 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1229 & restyp(itypi),i,restyp(itypj),j,
1230 & epsi,sigm,chi1,chi2,chip1,chip2,
1231 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1232 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1234 write (iout,*) "partial sum", evdw, evdw_t
1239 C Calculate gradient components.
1240 e1=e1*eps1*eps2rt**2*eps3rt**2
1241 fac=-expon*(e1+evdwij)*rij_shift
1244 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1245 C Calculate the radial part of the gradient
1249 C Calculate angular part of the gradient.
1252 C write(iout,*) "partial sum", evdw, evdw_t
1259 C-----------------------------------------------------------------------------
1260 subroutine egbv(evdw,evdw_t)
1262 C This subroutine calculates the interaction energy of nonbonded side chains
1263 C assuming the Gay-Berne-Vorobjev potential of interaction.
1265 implicit real*8 (a-h,o-z)
1266 include 'DIMENSIONS'
1267 include 'DIMENSIONS.ZSCOPT'
1268 include "DIMENSIONS.COMPAR"
1269 include 'COMMON.GEO'
1270 include 'COMMON.VAR'
1271 include 'COMMON.LOCAL'
1272 include 'COMMON.CHAIN'
1273 include 'COMMON.DERIV'
1274 include 'COMMON.NAMES'
1275 include 'COMMON.INTERACT'
1276 include 'COMMON.ENEPS'
1277 include 'COMMON.IOUNITS'
1278 include 'COMMON.CALC'
1279 common /srutu/ icall
1285 eneps_temp(j,i)=0.0d0
1290 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1293 c if (icall.gt.0) lprn=.true.
1295 do i=iatsc_s,iatsc_e
1296 itypi=iabs(itype(i))
1297 if (itypi.eq.ntyp1) cycle
1298 itypi1=iabs(itype(i+1))
1302 dxi=dc_norm(1,nres+i)
1303 dyi=dc_norm(2,nres+i)
1304 dzi=dc_norm(3,nres+i)
1305 dsci_inv=vbld_inv(i+nres)
1307 C Calculate SC interaction energy.
1309 do iint=1,nint_gr(i)
1310 do j=istart(i,iint),iend(i,iint)
1312 itypj=iabs(itype(j))
1313 if (itypj.eq.ntyp1) cycle
1314 dscj_inv=vbld_inv(j+nres)
1315 sig0ij=sigma(itypi,itypj)
1316 r0ij=r0(itypi,itypj)
1317 chi1=chi(itypi,itypj)
1318 chi2=chi(itypj,itypi)
1325 alf12=0.5D0*(alf1+alf2)
1326 C For diagnostics only!!!
1339 dxj=dc_norm(1,nres+j)
1340 dyj=dc_norm(2,nres+j)
1341 dzj=dc_norm(3,nres+j)
1342 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1344 C Calculate angle-dependent terms of energy and contributions to their
1348 sig=sig0ij*dsqrt(sigsq)
1349 rij_shift=1.0D0/rij-sig+r0ij
1350 C I hate to put IF's in the loops, but here don't have another choice!!!!
1351 if (rij_shift.le.0.0D0) then
1356 c---------------------------------------------------------------
1357 rij_shift=1.0D0/rij_shift
1358 fac=rij_shift**expon
1361 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1362 eps2der=evdwij*eps3rt
1363 eps3der=evdwij*eps2rt
1364 fac_augm=rrij**expon
1365 e_augm=augm(itypi,itypj)*fac_augm
1366 evdwij=evdwij*eps2rt*eps3rt
1367 if (bb.gt.0.0d0) then
1368 evdw=evdw+evdwij+e_augm
1370 evdw_t=evdw_t+evdwij+e_augm
1372 ij=icant(itypi,itypj)
1373 aux=eps1*eps2rt**2*eps3rt**2
1374 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1375 & /dabs(eps(itypi,itypj))
1376 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1377 c eneps_temp(ij)=eneps_temp(ij)
1378 c & +(evdwij+e_augm)/eps(itypi,itypj)
1380 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1381 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1382 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1383 c & restyp(itypi),i,restyp(itypj),j,
1384 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1385 c & chi1,chi2,chip1,chip2,
1386 c & eps1,eps2rt**2,eps3rt**2,
1387 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1391 C Calculate gradient components.
1392 e1=e1*eps1*eps2rt**2*eps3rt**2
1393 fac=-expon*(e1+evdwij)*rij_shift
1395 fac=rij*fac-2*expon*rrij*e_augm
1396 C Calculate the radial part of the gradient
1400 C Calculate angular part of the gradient.
1408 C-----------------------------------------------------------------------------
1409 subroutine sc_angular
1410 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1411 C om12. Called by ebp, egb, and egbv.
1413 include 'COMMON.CALC'
1417 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1418 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1419 om12=dxi*dxj+dyi*dyj+dzi*dzj
1421 C Calculate eps1(om12) and its derivative in om12
1422 faceps1=1.0D0-om12*chiom12
1423 faceps1_inv=1.0D0/faceps1
1424 eps1=dsqrt(faceps1_inv)
1425 C Following variable is eps1*deps1/dom12
1426 eps1_om12=faceps1_inv*chiom12
1427 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1432 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1433 sigsq=1.0D0-facsig*faceps1_inv
1434 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1435 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1436 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1437 C Calculate eps2 and its derivatives in om1, om2, and om12.
1440 chipom12=chip12*om12
1441 facp=1.0D0-om12*chipom12
1443 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1444 C Following variable is the square root of eps2
1445 eps2rt=1.0D0-facp1*facp_inv
1446 C Following three variables are the derivatives of the square root of eps
1447 C in om1, om2, and om12.
1448 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1449 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1450 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1451 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1452 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1453 C Calculate whole angle-dependent part of epsilon and contributions
1454 C to its derivatives
1457 C----------------------------------------------------------------------------
1459 implicit real*8 (a-h,o-z)
1460 include 'DIMENSIONS'
1461 include 'DIMENSIONS.ZSCOPT'
1462 include 'COMMON.CHAIN'
1463 include 'COMMON.DERIV'
1464 include 'COMMON.CALC'
1465 double precision dcosom1(3),dcosom2(3)
1466 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1467 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1468 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1469 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1471 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1472 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1475 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1478 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1479 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1480 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1481 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1482 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1483 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1486 C Calculate the components of the gradient in DC and X
1490 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1495 c------------------------------------------------------------------------------
1496 subroutine vec_and_deriv
1497 implicit real*8 (a-h,o-z)
1498 include 'DIMENSIONS'
1499 include 'DIMENSIONS.ZSCOPT'
1500 include 'COMMON.IOUNITS'
1501 include 'COMMON.GEO'
1502 include 'COMMON.VAR'
1503 include 'COMMON.LOCAL'
1504 include 'COMMON.CHAIN'
1505 include 'COMMON.VECTORS'
1506 include 'COMMON.DERIV'
1507 include 'COMMON.INTERACT'
1508 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1509 C Compute the local reference systems. For reference system (i), the
1510 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1511 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1513 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1514 if (i.eq.nres-1) then
1515 C Case of the last full residue
1516 C Compute the Z-axis
1517 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1518 costh=dcos(pi-theta(nres))
1519 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1524 C Compute the derivatives of uz
1526 uzder(2,1,1)=-dc_norm(3,i-1)
1527 uzder(3,1,1)= dc_norm(2,i-1)
1528 uzder(1,2,1)= dc_norm(3,i-1)
1530 uzder(3,2,1)=-dc_norm(1,i-1)
1531 uzder(1,3,1)=-dc_norm(2,i-1)
1532 uzder(2,3,1)= dc_norm(1,i-1)
1535 uzder(2,1,2)= dc_norm(3,i)
1536 uzder(3,1,2)=-dc_norm(2,i)
1537 uzder(1,2,2)=-dc_norm(3,i)
1539 uzder(3,2,2)= dc_norm(1,i)
1540 uzder(1,3,2)= dc_norm(2,i)
1541 uzder(2,3,2)=-dc_norm(1,i)
1544 C Compute the Y-axis
1547 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1550 C Compute the derivatives of uy
1553 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1554 & -dc_norm(k,i)*dc_norm(j,i-1)
1555 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1557 uyder(j,j,1)=uyder(j,j,1)-costh
1558 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1563 uygrad(l,k,j,i)=uyder(l,k,j)
1564 uzgrad(l,k,j,i)=uzder(l,k,j)
1568 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1569 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1570 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1571 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1575 C Compute the Z-axis
1576 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1577 costh=dcos(pi-theta(i+2))
1578 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1583 C Compute the derivatives of uz
1585 uzder(2,1,1)=-dc_norm(3,i+1)
1586 uzder(3,1,1)= dc_norm(2,i+1)
1587 uzder(1,2,1)= dc_norm(3,i+1)
1589 uzder(3,2,1)=-dc_norm(1,i+1)
1590 uzder(1,3,1)=-dc_norm(2,i+1)
1591 uzder(2,3,1)= dc_norm(1,i+1)
1594 uzder(2,1,2)= dc_norm(3,i)
1595 uzder(3,1,2)=-dc_norm(2,i)
1596 uzder(1,2,2)=-dc_norm(3,i)
1598 uzder(3,2,2)= dc_norm(1,i)
1599 uzder(1,3,2)= dc_norm(2,i)
1600 uzder(2,3,2)=-dc_norm(1,i)
1603 C Compute the Y-axis
1606 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1609 C Compute the derivatives of uy
1612 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1613 & -dc_norm(k,i)*dc_norm(j,i+1)
1614 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1616 uyder(j,j,1)=uyder(j,j,1)-costh
1617 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1622 uygrad(l,k,j,i)=uyder(l,k,j)
1623 uzgrad(l,k,j,i)=uzder(l,k,j)
1627 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1628 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1629 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1630 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1636 vbld_inv_temp(1)=vbld_inv(i+1)
1637 if (i.lt.nres-1) then
1638 vbld_inv_temp(2)=vbld_inv(i+2)
1640 vbld_inv_temp(2)=vbld_inv(i)
1645 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1646 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1654 C-----------------------------------------------------------------------------
1655 subroutine vec_and_deriv_test
1656 implicit real*8 (a-h,o-z)
1657 include 'DIMENSIONS'
1658 include 'DIMENSIONS.ZSCOPT'
1659 include 'COMMON.IOUNITS'
1660 include 'COMMON.GEO'
1661 include 'COMMON.VAR'
1662 include 'COMMON.LOCAL'
1663 include 'COMMON.CHAIN'
1664 include 'COMMON.VECTORS'
1665 dimension uyder(3,3,2),uzder(3,3,2)
1666 C Compute the local reference systems. For reference system (i), the
1667 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1668 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1670 if (i.eq.nres-1) then
1671 C Case of the last full residue
1672 C Compute the Z-axis
1673 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1674 costh=dcos(pi-theta(nres))
1675 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1676 c write (iout,*) 'fac',fac,
1677 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1678 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1682 C Compute the derivatives of uz
1684 uzder(2,1,1)=-dc_norm(3,i-1)
1685 uzder(3,1,1)= dc_norm(2,i-1)
1686 uzder(1,2,1)= dc_norm(3,i-1)
1688 uzder(3,2,1)=-dc_norm(1,i-1)
1689 uzder(1,3,1)=-dc_norm(2,i-1)
1690 uzder(2,3,1)= dc_norm(1,i-1)
1693 uzder(2,1,2)= dc_norm(3,i)
1694 uzder(3,1,2)=-dc_norm(2,i)
1695 uzder(1,2,2)=-dc_norm(3,i)
1697 uzder(3,2,2)= dc_norm(1,i)
1698 uzder(1,3,2)= dc_norm(2,i)
1699 uzder(2,3,2)=-dc_norm(1,i)
1701 C Compute the Y-axis
1703 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1706 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1707 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1708 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1710 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1713 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1714 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1717 c write (iout,*) 'facy',facy,
1718 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1719 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1721 uy(k,i)=facy*uy(k,i)
1723 C Compute the derivatives of uy
1726 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1727 & -dc_norm(k,i)*dc_norm(j,i-1)
1728 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1730 c uyder(j,j,1)=uyder(j,j,1)-costh
1731 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1732 uyder(j,j,1)=uyder(j,j,1)
1733 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1734 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1740 uygrad(l,k,j,i)=uyder(l,k,j)
1741 uzgrad(l,k,j,i)=uzder(l,k,j)
1745 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1746 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1747 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1748 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1751 C Compute the Z-axis
1752 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1753 costh=dcos(pi-theta(i+2))
1754 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1755 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1759 C Compute the derivatives of uz
1761 uzder(2,1,1)=-dc_norm(3,i+1)
1762 uzder(3,1,1)= dc_norm(2,i+1)
1763 uzder(1,2,1)= dc_norm(3,i+1)
1765 uzder(3,2,1)=-dc_norm(1,i+1)
1766 uzder(1,3,1)=-dc_norm(2,i+1)
1767 uzder(2,3,1)= dc_norm(1,i+1)
1770 uzder(2,1,2)= dc_norm(3,i)
1771 uzder(3,1,2)=-dc_norm(2,i)
1772 uzder(1,2,2)=-dc_norm(3,i)
1774 uzder(3,2,2)= dc_norm(1,i)
1775 uzder(1,3,2)= dc_norm(2,i)
1776 uzder(2,3,2)=-dc_norm(1,i)
1778 C Compute the Y-axis
1780 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1781 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1782 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1784 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1787 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1788 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1791 c write (iout,*) 'facy',facy,
1792 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1793 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1795 uy(k,i)=facy*uy(k,i)
1797 C Compute the derivatives of uy
1800 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1801 & -dc_norm(k,i)*dc_norm(j,i+1)
1802 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1804 c uyder(j,j,1)=uyder(j,j,1)-costh
1805 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1806 uyder(j,j,1)=uyder(j,j,1)
1807 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1808 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1814 uygrad(l,k,j,i)=uyder(l,k,j)
1815 uzgrad(l,k,j,i)=uzder(l,k,j)
1819 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1820 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1821 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1822 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1829 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1830 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1837 C-----------------------------------------------------------------------------
1838 subroutine check_vecgrad
1839 implicit real*8 (a-h,o-z)
1840 include 'DIMENSIONS'
1841 include 'DIMENSIONS.ZSCOPT'
1842 include 'COMMON.IOUNITS'
1843 include 'COMMON.GEO'
1844 include 'COMMON.VAR'
1845 include 'COMMON.LOCAL'
1846 include 'COMMON.CHAIN'
1847 include 'COMMON.VECTORS'
1848 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1849 dimension uyt(3,maxres),uzt(3,maxres)
1850 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1851 double precision delta /1.0d-7/
1854 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1855 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1856 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1857 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1858 cd & (dc_norm(if90,i),if90=1,3)
1859 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1860 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1861 cd write(iout,'(a)')
1867 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1868 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1881 cd write (iout,*) 'i=',i
1883 erij(k)=dc_norm(k,i)
1887 dc_norm(k,i)=erij(k)
1889 dc_norm(j,i)=dc_norm(j,i)+delta
1890 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1892 c dc_norm(k,i)=dc_norm(k,i)/fac
1894 c write (iout,*) (dc_norm(k,i),k=1,3)
1895 c write (iout,*) (erij(k),k=1,3)
1898 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1899 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1900 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1901 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1903 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1904 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1905 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1908 dc_norm(k,i)=erij(k)
1911 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1912 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1913 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1914 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1915 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1916 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1917 cd write (iout,'(a)')
1922 C--------------------------------------------------------------------------
1923 subroutine set_matrices
1924 implicit real*8 (a-h,o-z)
1925 include 'DIMENSIONS'
1926 include 'DIMENSIONS.ZSCOPT'
1927 include 'COMMON.IOUNITS'
1928 include 'COMMON.GEO'
1929 include 'COMMON.VAR'
1930 include 'COMMON.LOCAL'
1931 include 'COMMON.CHAIN'
1932 include 'COMMON.DERIV'
1933 include 'COMMON.INTERACT'
1934 include 'COMMON.CONTACTS'
1935 include 'COMMON.TORSION'
1936 include 'COMMON.VECTORS'
1937 include 'COMMON.FFIELD'
1938 double precision auxvec(2),auxmat(2,2)
1940 C Compute the virtual-bond-torsional-angle dependent quantities needed
1941 C to calculate the el-loc multibody terms of various order.
1944 if (i .lt. nres+1) then
1981 if (i .gt. 3 .and. i .lt. nres+1) then
1982 obrot_der(1,i-2)=-sin1
1983 obrot_der(2,i-2)= cos1
1984 Ugder(1,1,i-2)= sin1
1985 Ugder(1,2,i-2)=-cos1
1986 Ugder(2,1,i-2)=-cos1
1987 Ugder(2,2,i-2)=-sin1
1990 obrot2_der(1,i-2)=-dwasin2
1991 obrot2_der(2,i-2)= dwacos2
1992 Ug2der(1,1,i-2)= dwasin2
1993 Ug2der(1,2,i-2)=-dwacos2
1994 Ug2der(2,1,i-2)=-dwacos2
1995 Ug2der(2,2,i-2)=-dwasin2
1997 obrot_der(1,i-2)=0.0d0
1998 obrot_der(2,i-2)=0.0d0
1999 Ugder(1,1,i-2)=0.0d0
2000 Ugder(1,2,i-2)=0.0d0
2001 Ugder(2,1,i-2)=0.0d0
2002 Ugder(2,2,i-2)=0.0d0
2003 obrot2_der(1,i-2)=0.0d0
2004 obrot2_der(2,i-2)=0.0d0
2005 Ug2der(1,1,i-2)=0.0d0
2006 Ug2der(1,2,i-2)=0.0d0
2007 Ug2der(2,1,i-2)=0.0d0
2008 Ug2der(2,2,i-2)=0.0d0
2010 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2011 if (itype(i-2).le.ntyp) then
2012 iti = itortyp(itype(i-2))
2019 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2020 if (itype(i-1).le.ntyp) then
2021 iti1 = itortyp(itype(i-1))
2028 cd write (iout,*) '*******i',i,' iti1',iti
2029 cd write (iout,*) 'b1',b1(:,iti)
2030 cd write (iout,*) 'b2',b2(:,iti)
2031 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2032 c print *,"itilde1 i iti iti1",i,iti,iti1
2033 if (i .gt. iatel_s+2) then
2034 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2035 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2036 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2037 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2038 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2039 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2040 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2050 DtUg2(l,k,i-2)=0.0d0
2054 c print *,"itilde2 i iti iti1",i,iti,iti1
2055 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2056 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2057 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2058 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2059 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2060 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2061 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2062 c print *,"itilde3 i iti iti1",i,iti,iti1
2064 muder(k,i-2)=Ub2der(k,i-2)
2066 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2067 if (itype(i-1).le.ntyp) then
2068 iti1 = itortyp(itype(i-1))
2076 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2078 C write (iout,*) 'mumu',i,b1(1,iti),Ub2(1,i-2)
2080 C Vectors and matrices dependent on a single virtual-bond dihedral.
2081 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2082 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2083 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2084 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2085 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2086 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2087 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2088 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2089 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2090 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
2091 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
2093 C Matrices dependent on two consecutive virtual-bond dihedrals.
2094 C The order of matrices is from left to right.
2096 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2097 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2098 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2099 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2100 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2101 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2102 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2103 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2106 cd iti = itortyp(itype(i))
2109 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2110 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2115 C--------------------------------------------------------------------------
2116 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2118 C This subroutine calculates the average interaction energy and its gradient
2119 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2120 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2121 C The potential depends both on the distance of peptide-group centers and on
2122 C the orientation of the CA-CA virtual bonds.
2124 implicit real*8 (a-h,o-z)
2125 include 'DIMENSIONS'
2126 include 'DIMENSIONS.ZSCOPT'
2127 include 'COMMON.CONTROL'
2128 include 'COMMON.IOUNITS'
2129 include 'COMMON.GEO'
2130 include 'COMMON.VAR'
2131 include 'COMMON.LOCAL'
2132 include 'COMMON.CHAIN'
2133 include 'COMMON.DERIV'
2134 include 'COMMON.INTERACT'
2135 include 'COMMON.CONTACTS'
2136 include 'COMMON.TORSION'
2137 include 'COMMON.VECTORS'
2138 include 'COMMON.FFIELD'
2139 include 'COMMON.SHIELD'
2140 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2141 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2142 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2143 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2144 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2145 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2146 double precision scal_el /0.5d0/
2148 C 13-go grudnia roku pamietnego...
2149 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2150 & 0.0d0,1.0d0,0.0d0,
2151 & 0.0d0,0.0d0,1.0d0/
2152 cd write(iout,*) 'In EELEC'
2154 cd write(iout,*) 'Type',i
2155 cd write(iout,*) 'B1',B1(:,i)
2156 cd write(iout,*) 'B2',B2(:,i)
2157 cd write(iout,*) 'CC',CC(:,:,i)
2158 cd write(iout,*) 'DD',DD(:,:,i)
2159 cd write(iout,*) 'EE',EE(:,:,i)
2161 cd call check_vecgrad
2163 if (icheckgrad.eq.1) then
2165 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2167 dc_norm(k,i)=dc(k,i)*fac
2169 c write (iout,*) 'i',i,' fac',fac
2172 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2173 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2174 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2175 cd if (wel_loc.gt.0.0d0) then
2176 if (icheckgrad.eq.1) then
2177 call vec_and_deriv_test
2184 cd write (iout,*) 'i=',i
2186 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2189 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2190 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2203 C print '(a)','Enter EELEC'
2204 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2206 gel_loc_loc(i)=0.0d0
2209 do i=iatel_s,iatel_e
2211 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2212 C & .or. itype(i+2).eq.ntyp1) cycle
2214 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2215 C & .or. itype(i+2).eq.ntyp1
2216 C & .or. itype(i-1).eq.ntyp1
2219 if (itel(i).eq.0) goto 1215
2223 dx_normi=dc_norm(1,i)
2224 dy_normi=dc_norm(2,i)
2225 dz_normi=dc_norm(3,i)
2226 xmedi=c(1,i)+0.5d0*dxi
2227 ymedi=c(2,i)+0.5d0*dyi
2228 zmedi=c(3,i)+0.5d0*dzi
2229 xmedi=mod(xmedi,boxxsize)
2230 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2231 ymedi=mod(ymedi,boxysize)
2232 if (ymedi.lt.0) ymedi=ymedi+boxysize
2233 zmedi=mod(zmedi,boxzsize)
2234 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2235 zmedi2=mod(zmedi,boxzsize)
2236 if (zmedi2.lt.0) zmedi2=zmedi2+boxzsize
2237 if ((zmedi2.gt.bordlipbot)
2238 &.and.(zmedi2.lt.bordliptop)) then
2239 C the energy transfer exist
2240 if (zmedi2.lt.buflipbot) then
2241 C what fraction I am in
2243 & ((zmedi2-bordlipbot)/lipbufthick)
2244 C lipbufthick is thickenes of lipid buffore
2245 sslipi=sscalelip(fracinbuf)
2246 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2247 elseif (zmedi2.gt.bufliptop) then
2248 fracinbuf=1.0d0-((bordliptop-zmedi2)/lipbufthick)
2249 sslipi=sscalelip(fracinbuf)
2250 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2261 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2262 do j=ielstart(i),ielend(i)
2264 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2265 C & .or.itype(j+2).eq.ntyp1
2268 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2269 C & .or.itype(j+2).eq.ntyp1
2270 C & .or.itype(j-1).eq.ntyp1
2275 if (itel(j).eq.0) goto 1216
2279 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2280 aaa=app(iteli,itelj)
2281 bbb=bpp(iteli,itelj)
2282 C Diagnostics only!!!
2288 ael6i=ael6(iteli,itelj)
2289 ael3i=ael3(iteli,itelj)
2293 dx_normj=dc_norm(1,j)
2294 dy_normj=dc_norm(2,j)
2295 dz_normj=dc_norm(3,j)
2300 if (xj.lt.0) xj=xj+boxxsize
2302 if (yj.lt.0) yj=yj+boxysize
2304 if (zj.lt.0) zj=zj+boxzsize
2305 if ((zj.gt.bordlipbot)
2306 &.and.(zj.lt.bordliptop)) then
2307 C the energy transfer exist
2308 if (zj.lt.buflipbot) then
2309 C what fraction I am in
2311 & ((zj-bordlipbot)/lipbufthick)
2312 C lipbufthick is thickenes of lipid buffore
2313 sslipj=sscalelip(fracinbuf)
2314 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2315 elseif (zj.gt.bufliptop) then
2316 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2317 sslipj=sscalelip(fracinbuf)
2318 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2327 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2335 xj=xj_safe+xshift*boxxsize
2336 yj=yj_safe+yshift*boxysize
2337 zj=zj_safe+zshift*boxzsize
2338 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2339 if(dist_temp.lt.dist_init) then
2349 if (isubchap.eq.1) then
2358 rij=xj*xj+yj*yj+zj*zj
2359 sss=sscale(sqrt(rij))
2360 sssgrad=sscagrad(sqrt(rij))
2366 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2367 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2368 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2369 fac=cosa-3.0D0*cosb*cosg
2371 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2372 if (j.eq.i+2) ev1=scal_el*ev1
2377 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2380 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2381 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2382 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2383 if (shield_mode.gt.0) then
2386 write(iout,*) "ees_compon",i,j,el1,el2,
2387 & fac_shield(i),fac_shield(j)
2392 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2393 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2402 evdw1=evdw1+evdwij*sss
2403 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2404 c &'evdw1',i,j,evdwij
2405 c &,iteli,itelj,aaa,evdw1
2407 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2408 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2409 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2410 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2411 c & xmedi,ymedi,zmedi,xj,yj,zj
2413 C Calculate contributions to the Cartesian gradient.
2416 facvdw=-6*rrmij*(ev1+evdwij)*sss
2417 facel=-3*rrmij*(el1+eesij)
2424 * Radial derivatives. First process both termini of the fragment (i,j)
2429 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2430 & (shield_mode.gt.0)) then
2432 do ilist=1,ishield_list(i)
2433 iresshield=shield_list(ilist,i)
2435 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2437 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2439 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2440 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2441 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2442 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2443 C if (iresshield.gt.i) then
2444 C do ishi=i+1,iresshield-1
2445 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2446 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2450 C do ishi=iresshield,i
2451 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2452 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2458 do ilist=1,ishield_list(j)
2459 iresshield=shield_list(ilist,j)
2461 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2463 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2465 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2466 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2471 gshieldc(k,i)=gshieldc(k,i)+
2472 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2473 gshieldc(k,j)=gshieldc(k,j)+
2474 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2475 gshieldc(k,i-1)=gshieldc(k,i-1)+
2476 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2477 gshieldc(k,j-1)=gshieldc(k,j-1)+
2478 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2485 gelc(k,i)=gelc(k,i)+ghalf
2486 gelc(k,j)=gelc(k,j)+ghalf
2489 * Loop over residues i+1 thru j-1.
2493 gelc(l,k)=gelc(l,k)+ggg(l)
2499 if (sss.gt.0.0) then
2500 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2501 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2502 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2510 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2511 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2514 * Loop over residues i+1 thru j-1.
2518 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2522 facvdw=(ev1+evdwij)*sss
2525 fac=-3*rrmij*(facvdw+facvdw+facel)
2531 * Radial derivatives. First process both termini of the fragment (i,j)
2538 gelc(k,i)=gelc(k,i)+ghalf
2539 gelc(k,j)=gelc(k,j)+ghalf
2542 * Loop over residues i+1 thru j-1.
2546 gelc(l,k)=gelc(l,k)+ggg(l)
2553 ecosa=2.0D0*fac3*fac1+fac4
2556 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2557 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2559 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2560 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2562 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2563 cd & (dcosg(k),k=1,3)
2565 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2566 & *fac_shield(i)**2*fac_shield(j)**2
2570 gelc(k,i)=gelc(k,i)+ghalf
2571 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2572 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2573 & *fac_shield(i)**2*fac_shield(j)**2
2575 gelc(k,j)=gelc(k,j)+ghalf
2576 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2577 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2578 & *fac_shield(i)**2*fac_shield(j)**2
2582 gelc(l,k)=gelc(l,k)+ggg(l)
2587 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2588 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2589 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2591 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2592 C energy of a peptide unit is assumed in the form of a second-order
2593 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2594 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2595 C are computed for EVERY pair of non-contiguous peptide groups.
2597 if (j.lt.nres-1) then
2608 muij(kkk)=mu(k,i)*mu(l,j)
2611 cd write (iout,*) 'EELEC: i',i,' j',j
2612 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2613 cd write(iout,*) 'muij',muij
2614 ury=scalar(uy(1,i),erij)
2615 urz=scalar(uz(1,i),erij)
2616 vry=scalar(uy(1,j),erij)
2617 vrz=scalar(uz(1,j),erij)
2618 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2619 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2620 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2621 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2622 C For diagnostics only
2627 fac=dsqrt(-ael6i)*r3ij
2628 cd write (2,*) 'fac=',fac
2629 C For diagnostics only
2635 cd write (iout,'(4i5,4f10.5)')
2636 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2637 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2638 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2639 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2640 cd write (iout,'(4f10.5)')
2641 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2642 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2643 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2644 cd write (iout,'(2i3,9f10.5/)') i,j,
2645 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2647 C Derivatives of the elements of A in virtual-bond vectors
2648 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2655 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2656 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2657 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2658 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2659 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2660 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2661 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2662 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2663 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2664 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2665 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2666 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2676 C Compute radial contributions to the gradient
2698 C Add the contributions coming from er
2701 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2702 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2703 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2704 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2707 C Derivatives in DC(i)
2708 ghalf1=0.5d0*agg(k,1)
2709 ghalf2=0.5d0*agg(k,2)
2710 ghalf3=0.5d0*agg(k,3)
2711 ghalf4=0.5d0*agg(k,4)
2712 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2713 & -3.0d0*uryg(k,2)*vry)+ghalf1
2714 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2715 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2716 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2717 & -3.0d0*urzg(k,2)*vry)+ghalf3
2718 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2719 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2720 C Derivatives in DC(i+1)
2721 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2722 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2723 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2724 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2725 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2726 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2727 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2728 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2729 C Derivatives in DC(j)
2730 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2731 & -3.0d0*vryg(k,2)*ury)+ghalf1
2732 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2733 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2734 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2735 & -3.0d0*vryg(k,2)*urz)+ghalf3
2736 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2737 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2738 C Derivatives in DC(j+1) or DC(nres-1)
2739 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2740 & -3.0d0*vryg(k,3)*ury)
2741 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2742 & -3.0d0*vrzg(k,3)*ury)
2743 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2744 & -3.0d0*vryg(k,3)*urz)
2745 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2746 & -3.0d0*vrzg(k,3)*urz)
2751 C Derivatives in DC(i+1)
2752 cd aggi1(k,1)=agg(k,1)
2753 cd aggi1(k,2)=agg(k,2)
2754 cd aggi1(k,3)=agg(k,3)
2755 cd aggi1(k,4)=agg(k,4)
2756 C Derivatives in DC(j)
2761 C Derivatives in DC(j+1)
2766 if (j.eq.nres-1 .and. i.lt.j-2) then
2768 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2769 cd aggj1(k,l)=agg(k,l)
2775 C Check the loc-el terms by numerical integration
2785 aggi(k,l)=-aggi(k,l)
2786 aggi1(k,l)=-aggi1(k,l)
2787 aggj(k,l)=-aggj(k,l)
2788 aggj1(k,l)=-aggj1(k,l)
2791 if (j.lt.nres-1) then
2797 aggi(k,l)=-aggi(k,l)
2798 aggi1(k,l)=-aggi1(k,l)
2799 aggj(k,l)=-aggj(k,l)
2800 aggj1(k,l)=-aggj1(k,l)
2811 aggi(k,l)=-aggi(k,l)
2812 aggi1(k,l)=-aggi1(k,l)
2813 aggj(k,l)=-aggj(k,l)
2814 aggj1(k,l)=-aggj1(k,l)
2820 IF (wel_loc.gt.0.0d0) THEN
2821 C Contribution to the local-electrostatic energy coming from the i-j pair
2822 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2824 if (shield_mode.eq.0) then
2831 eel_loc_ij=eel_loc_ij
2832 & *fac_shield(i)*fac_shield(j)
2833 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2834 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2835 C write (iout,'(a6,2i5,0pf7.3)')
2836 C & 'eelloc',i,j,eel_loc_ij
2837 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2838 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2839 C eel_loc=eel_loc+eel_loc_ij
2840 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2841 & (shield_mode.gt.0)) then
2844 do ilist=1,ishield_list(i)
2845 iresshield=shield_list(ilist,i)
2847 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2850 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2852 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2853 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2857 do ilist=1,ishield_list(j)
2858 iresshield=shield_list(ilist,j)
2860 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2863 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2865 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2866 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2872 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2873 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2874 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2875 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2876 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2877 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2878 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2879 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2882 eel_loc=eel_loc+eel_loc_ij
2884 C Partial derivatives in virtual-bond dihedral angles gamma
2887 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2888 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2889 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
2890 & *fac_shield(i)*fac_shield(j)
2891 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2893 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2894 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2895 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
2896 & *fac_shield(i)*fac_shield(j)
2897 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2899 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2900 cd write(iout,*) 'agg ',agg
2901 cd write(iout,*) 'aggi ',aggi
2902 cd write(iout,*) 'aggi1',aggi1
2903 cd write(iout,*) 'aggj ',aggj
2904 cd write(iout,*) 'aggj1',aggj1
2906 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2908 ggg(l)=(agg(l,1)*muij(1)+
2909 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
2910 & *fac_shield(i)*fac_shield(j)
2911 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2916 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2919 C Remaining derivatives of eello
2921 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
2922 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
2923 & *fac_shield(i)*fac_shield(j)
2924 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2926 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
2927 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
2928 & *fac_shield(i)*fac_shield(j)
2929 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2931 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
2932 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
2933 & *fac_shield(i)*fac_shield(j)
2934 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2936 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
2937 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
2938 & *fac_shield(i)*fac_shield(j)
2939 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2944 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2945 C Contributions from turns
2950 call eturn34(i,j,eello_turn3,eello_turn4)
2952 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2953 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2955 C Calculate the contact function. The ith column of the array JCONT will
2956 C contain the numbers of atoms that make contacts with the atom I (of numbers
2957 C greater than I). The arrays FACONT and GACONT will contain the values of
2958 C the contact function and its derivative.
2959 c r0ij=1.02D0*rpp(iteli,itelj)
2960 c r0ij=1.11D0*rpp(iteli,itelj)
2961 r0ij=2.20D0*rpp(iteli,itelj)
2962 c r0ij=1.55D0*rpp(iteli,itelj)
2963 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2964 if (fcont.gt.0.0D0) then
2965 num_conti=num_conti+1
2966 if (num_conti.gt.maxconts) then
2967 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2968 & ' will skip next contacts for this conf.'
2970 jcont_hb(num_conti,i)=j
2971 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2972 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2973 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2975 d_cont(num_conti,i)=rij
2976 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2977 C --- Electrostatic-interaction matrix ---
2978 a_chuj(1,1,num_conti,i)=a22
2979 a_chuj(1,2,num_conti,i)=a23
2980 a_chuj(2,1,num_conti,i)=a32
2981 a_chuj(2,2,num_conti,i)=a33
2982 C --- Gradient of rij
2984 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2987 c a_chuj(1,1,num_conti,i)=-0.61d0
2988 c a_chuj(1,2,num_conti,i)= 0.4d0
2989 c a_chuj(2,1,num_conti,i)= 0.65d0
2990 c a_chuj(2,2,num_conti,i)= 0.50d0
2991 c else if (i.eq.2) then
2992 c a_chuj(1,1,num_conti,i)= 0.0d0
2993 c a_chuj(1,2,num_conti,i)= 0.0d0
2994 c a_chuj(2,1,num_conti,i)= 0.0d0
2995 c a_chuj(2,2,num_conti,i)= 0.0d0
2997 C --- and its gradients
2998 cd write (iout,*) 'i',i,' j',j
3000 cd write (iout,*) 'iii 1 kkk',kkk
3001 cd write (iout,*) agg(kkk,:)
3004 cd write (iout,*) 'iii 2 kkk',kkk
3005 cd write (iout,*) aggi(kkk,:)
3008 cd write (iout,*) 'iii 3 kkk',kkk
3009 cd write (iout,*) aggi1(kkk,:)
3012 cd write (iout,*) 'iii 4 kkk',kkk
3013 cd write (iout,*) aggj(kkk,:)
3016 cd write (iout,*) 'iii 5 kkk',kkk
3017 cd write (iout,*) aggj1(kkk,:)
3024 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3025 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3026 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3027 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3028 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3030 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
3036 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3037 C Calculate contact energies
3039 wij=cosa-3.0D0*cosb*cosg
3042 c fac3=dsqrt(-ael6i)/r0ij**3
3043 fac3=dsqrt(-ael6i)*r3ij
3044 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3045 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3047 if (shield_mode.eq.0) then
3051 ees0plist(num_conti,i)=j
3052 C fac_shield(i)=0.4d0
3053 C fac_shield(j)=0.6d0
3055 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3056 & *fac_shield(i)*fac_shield(j)
3058 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3059 & *fac_shield(i)*fac_shield(j)
3061 C Diagnostics. Comment out or remove after debugging!
3062 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3063 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3064 c ees0m(num_conti,i)=0.0D0
3066 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3067 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3068 facont_hb(num_conti,i)=fcont
3070 C Angular derivatives of the contact function
3071 ees0pij1=fac3/ees0pij
3072 ees0mij1=fac3/ees0mij
3073 fac3p=-3.0D0*fac3*rrmij
3074 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3075 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3077 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3078 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3079 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3080 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3081 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3082 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3083 ecosap=ecosa1+ecosa2
3084 ecosbp=ecosb1+ecosb2
3085 ecosgp=ecosg1+ecosg2
3086 ecosam=ecosa1-ecosa2
3087 ecosbm=ecosb1-ecosb2
3088 ecosgm=ecosg1-ecosg2
3097 fprimcont=fprimcont/rij
3098 cd facont_hb(num_conti,i)=1.0D0
3099 C Following line is for diagnostics.
3102 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3103 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3106 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3107 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3109 gggp(1)=gggp(1)+ees0pijp*xj
3110 gggp(2)=gggp(2)+ees0pijp*yj
3111 gggp(3)=gggp(3)+ees0pijp*zj
3112 gggm(1)=gggm(1)+ees0mijp*xj
3113 gggm(2)=gggm(2)+ees0mijp*yj
3114 gggm(3)=gggm(3)+ees0mijp*zj
3115 C Derivatives due to the contact function
3116 gacont_hbr(1,num_conti,i)=fprimcont*xj
3117 gacont_hbr(2,num_conti,i)=fprimcont*yj
3118 gacont_hbr(3,num_conti,i)=fprimcont*zj
3120 ghalfp=0.5D0*gggp(k)
3121 ghalfm=0.5D0*gggm(k)
3122 gacontp_hb1(k,num_conti,i)=ghalfp
3123 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3124 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3125 & *fac_shield(i)*fac_shield(j)
3127 gacontp_hb2(k,num_conti,i)=ghalfp
3128 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3129 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3130 & *fac_shield(i)*fac_shield(j)
3132 gacontp_hb3(k,num_conti,i)=gggp(k)
3133 & *fac_shield(i)*fac_shield(j)
3135 gacontm_hb1(k,num_conti,i)=ghalfm
3136 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3137 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3138 & *fac_shield(i)*fac_shield(j)
3140 gacontm_hb2(k,num_conti,i)=ghalfm
3141 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3142 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3143 & *fac_shield(i)*fac_shield(j)
3145 gacontm_hb3(k,num_conti,i)=gggm(k)
3146 & *fac_shield(i)*fac_shield(j)
3150 C Diagnostics. Comment out or remove after debugging!
3152 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3153 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3154 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3155 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3156 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3157 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3160 endif ! num_conti.le.maxconts
3165 num_cont_hb(i)=num_conti
3169 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3170 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3172 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3173 ccc eel_loc=eel_loc+eello_turn3
3176 C-----------------------------------------------------------------------------
3177 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3178 C Third- and fourth-order contributions from turns
3179 implicit real*8 (a-h,o-z)
3180 include 'DIMENSIONS'
3181 include 'DIMENSIONS.ZSCOPT'
3182 include 'COMMON.IOUNITS'
3183 include 'COMMON.GEO'
3184 include 'COMMON.VAR'
3185 include 'COMMON.LOCAL'
3186 include 'COMMON.CHAIN'
3187 include 'COMMON.DERIV'
3188 include 'COMMON.INTERACT'
3189 include 'COMMON.CONTACTS'
3190 include 'COMMON.TORSION'
3191 include 'COMMON.VECTORS'
3192 include 'COMMON.FFIELD'
3193 include 'COMMON.SHIELD'
3194 include 'COMMON.CONTROL'
3196 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3197 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3198 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3199 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3200 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3201 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3202 zj=(c(3,j)+c(3,j+1))/2.0d0
3203 C xj=mod(xj,boxxsize)
3204 C if (xj.lt.0) xj=xj+boxxsize
3205 C yj=mod(yj,boxysize)
3206 C if (yj.lt.0) yj=yj+boxysize
3208 if (zj.lt.0) zj=zj+boxzsize
3209 C if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3210 if ((zj.gt.bordlipbot)
3211 &.and.(zj.lt.bordliptop)) then
3212 C the energy transfer exist
3213 if (zj.lt.buflipbot) then
3214 C what fraction I am in
3216 & ((zj-bordlipbot)/lipbufthick)
3217 C lipbufthick is thickenes of lipid buffore
3218 sslipj=sscalelip(fracinbuf)
3219 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3220 elseif (zj.gt.bufliptop) then
3221 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3222 sslipj=sscalelip(fracinbuf)
3223 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3234 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3235 C changes suggested by Ana to avoid out of bounds
3236 C & .or.((i+5).gt.nres)
3237 C & .or.((i-1).le.0)
3238 C end of changes suggested by Ana
3239 & .or. itype(i+2).eq.ntyp1
3240 & .or. itype(i+3).eq.ntyp1
3241 C & .or. itype(i+5).eq.ntyp1
3242 C & .or. itype(i).eq.ntyp1
3243 C & .or. itype(i-1).eq.ntyp1
3246 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3248 C Third-order contributions
3255 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3256 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3257 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3258 call transpose2(auxmat(1,1),auxmat1(1,1))
3259 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3260 if (shield_mode.eq.0) then
3268 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3269 & *fac_shield(i)*fac_shield(j)
3270 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3272 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3273 & *fac_shield(i)*fac_shield(j)
3274 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3276 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3277 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3278 cd & ' eello_turn3_num',4*eello_turn3_num
3280 C Derivatives in shield mode
3281 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3282 & (shield_mode.gt.0)) then
3285 do ilist=1,ishield_list(i)
3286 iresshield=shield_list(ilist,i)
3288 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3290 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3292 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3293 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3297 do ilist=1,ishield_list(j)
3298 iresshield=shield_list(ilist,j)
3300 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3302 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3304 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3305 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3312 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3313 & grad_shield(k,i)*eello_t3/fac_shield(i)
3314 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3315 & grad_shield(k,j)*eello_t3/fac_shield(j)
3316 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3317 & grad_shield(k,i)*eello_t3/fac_shield(i)
3318 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3319 & grad_shield(k,j)*eello_t3/fac_shield(j)
3323 C Derivatives in gamma(i)
3324 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3325 call transpose2(auxmat2(1,1),pizda(1,1))
3326 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3327 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3328 & *fac_shield(i)*fac_shield(j)
3329 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3331 C Derivatives in gamma(i+1)
3332 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3333 call transpose2(auxmat2(1,1),pizda(1,1))
3334 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3335 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3336 & +0.5d0*(pizda(1,1)+pizda(2,2))
3337 & *fac_shield(i)*fac_shield(j)
3338 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3340 C Cartesian derivatives
3342 a_temp(1,1)=aggi(l,1)
3343 a_temp(1,2)=aggi(l,2)
3344 a_temp(2,1)=aggi(l,3)
3345 a_temp(2,2)=aggi(l,4)
3346 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3347 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3348 & +0.5d0*(pizda(1,1)+pizda(2,2))
3349 & *fac_shield(i)*fac_shield(j)
3350 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3352 a_temp(1,1)=aggi1(l,1)
3353 a_temp(1,2)=aggi1(l,2)
3354 a_temp(2,1)=aggi1(l,3)
3355 a_temp(2,2)=aggi1(l,4)
3356 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3357 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3358 & +0.5d0*(pizda(1,1)+pizda(2,2))
3359 & *fac_shield(i)*fac_shield(j)
3360 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3362 a_temp(1,1)=aggj(l,1)
3363 a_temp(1,2)=aggj(l,2)
3364 a_temp(2,1)=aggj(l,3)
3365 a_temp(2,2)=aggj(l,4)
3366 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3367 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3368 & +0.5d0*(pizda(1,1)+pizda(2,2))
3369 & *fac_shield(i)*fac_shield(j)
3370 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3372 a_temp(1,1)=aggj1(l,1)
3373 a_temp(1,2)=aggj1(l,2)
3374 a_temp(2,1)=aggj1(l,3)
3375 a_temp(2,2)=aggj1(l,4)
3376 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3377 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3378 & +0.5d0*(pizda(1,1)+pizda(2,2))
3379 & *fac_shield(i)*fac_shield(j)
3380 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3385 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3386 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3387 C changes suggested by Ana to avoid out of bounds
3388 C & .or.((i+5).gt.nres)
3389 C & .or.((i-1).le.0)
3390 C end of changes suggested by Ana
3391 & .or. itype(i+3).eq.ntyp1
3392 & .or. itype(i+4).eq.ntyp1
3393 C & .or. itype(i+5).eq.ntyp1
3394 & .or. itype(i).eq.ntyp1
3395 C & .or. itype(i-1).eq.ntyp1
3397 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3399 C Fourth-order contributions
3407 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3408 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3409 iti1=itortyp(itype(i+1))
3410 iti2=itortyp(itype(i+2))
3411 iti3=itortyp(itype(i+3))
3412 call transpose2(EUg(1,1,i+1),e1t(1,1))
3413 call transpose2(Eug(1,1,i+2),e2t(1,1))
3414 call transpose2(Eug(1,1,i+3),e3t(1,1))
3415 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3416 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3417 s1=scalar2(b1(1,iti2),auxvec(1))
3418 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3419 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3420 s2=scalar2(b1(1,iti1),auxvec(1))
3421 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3422 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3423 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3424 if (shield_mode.eq.0) then
3432 eello_turn4=eello_turn4-(s1+s2+s3)
3433 & *fac_shield(i)*fac_shield(j)
3434 eello_t4=-(s1+s2+s3)
3435 & *fac_shield(i)*fac_shield(j)
3437 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3438 cd & ' eello_turn4_num',8*eello_turn4_num
3439 C Derivatives in gamma(i)
3441 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3442 & (shield_mode.gt.0)) then
3445 do ilist=1,ishield_list(i)
3446 iresshield=shield_list(ilist,i)
3448 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3450 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3452 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3453 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3457 do ilist=1,ishield_list(j)
3458 iresshield=shield_list(ilist,j)
3460 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3462 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3464 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3465 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3472 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3473 & grad_shield(k,i)*eello_t4/fac_shield(i)
3474 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3475 & grad_shield(k,j)*eello_t4/fac_shield(j)
3476 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3477 & grad_shield(k,i)*eello_t4/fac_shield(i)
3478 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3479 & grad_shield(k,j)*eello_t4/fac_shield(j)
3482 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3483 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3484 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3485 s1=scalar2(b1(1,iti2),auxvec(1))
3486 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3487 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3488 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3489 & *fac_shield(i)*fac_shield(j)
3490 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3492 C Derivatives in gamma(i+1)
3493 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3494 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3495 s2=scalar2(b1(1,iti1),auxvec(1))
3496 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3497 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3498 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3499 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3500 & *fac_shield(i)*fac_shield(j)
3501 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3503 C Derivatives in gamma(i+2)
3504 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3505 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3506 s1=scalar2(b1(1,iti2),auxvec(1))
3507 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3508 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3509 s2=scalar2(b1(1,iti1),auxvec(1))
3510 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3511 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3512 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3513 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3514 & *fac_shield(i)*fac_shield(j)
3515 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3517 C Cartesian derivatives
3519 C Derivatives of this turn contributions in DC(i+2)
3520 if (j.lt.nres-1) then
3522 a_temp(1,1)=agg(l,1)
3523 a_temp(1,2)=agg(l,2)
3524 a_temp(2,1)=agg(l,3)
3525 a_temp(2,2)=agg(l,4)
3526 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3527 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3528 s1=scalar2(b1(1,iti2),auxvec(1))
3529 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3530 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3531 s2=scalar2(b1(1,iti1),auxvec(1))
3532 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3533 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3534 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3536 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3537 & *fac_shield(i)*fac_shield(j)
3538 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3542 C Remaining derivatives of this turn contribution
3544 a_temp(1,1)=aggi(l,1)
3545 a_temp(1,2)=aggi(l,2)
3546 a_temp(2,1)=aggi(l,3)
3547 a_temp(2,2)=aggi(l,4)
3548 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3549 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3550 s1=scalar2(b1(1,iti2),auxvec(1))
3551 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3552 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3553 s2=scalar2(b1(1,iti1),auxvec(1))
3554 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3555 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3556 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3557 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3558 & *fac_shield(i)*fac_shield(j)
3559 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3561 a_temp(1,1)=aggi1(l,1)
3562 a_temp(1,2)=aggi1(l,2)
3563 a_temp(2,1)=aggi1(l,3)
3564 a_temp(2,2)=aggi1(l,4)
3565 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3566 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3567 s1=scalar2(b1(1,iti2),auxvec(1))
3568 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3569 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3570 s2=scalar2(b1(1,iti1),auxvec(1))
3571 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3572 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3573 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3574 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3575 & *fac_shield(i)*fac_shield(j)
3576 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3578 a_temp(1,1)=aggj(l,1)
3579 a_temp(1,2)=aggj(l,2)
3580 a_temp(2,1)=aggj(l,3)
3581 a_temp(2,2)=aggj(l,4)
3582 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3583 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3584 s1=scalar2(b1(1,iti2),auxvec(1))
3585 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3586 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3587 s2=scalar2(b1(1,iti1),auxvec(1))
3588 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3589 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3590 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3591 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3592 & *fac_shield(i)*fac_shield(j)
3593 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3595 a_temp(1,1)=aggj1(l,1)
3596 a_temp(1,2)=aggj1(l,2)
3597 a_temp(2,1)=aggj1(l,3)
3598 a_temp(2,2)=aggj1(l,4)
3599 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3600 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3601 s1=scalar2(b1(1,iti2),auxvec(1))
3602 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3603 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3604 s2=scalar2(b1(1,iti1),auxvec(1))
3605 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3606 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3607 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3608 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3609 & *fac_shield(i)*fac_shield(j)
3610 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3613 gshieldc_t4(3,i)=gshieldc_t4(3,i)+
3614 & ssgradlipi*eello_t4/4.0d0*lipscale
3615 gshieldc_t4(3,j)=gshieldc_t4(3,j)+
3616 & ssgradlipj*eello_t4/4.0d0*lipscale
3617 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+
3618 & ssgradlipi*eello_t4/4.0d0*lipscale
3619 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+
3620 & ssgradlipj*eello_t4/4.0d0*lipscale
3626 C-----------------------------------------------------------------------------
3627 subroutine vecpr(u,v,w)
3628 implicit real*8(a-h,o-z)
3629 dimension u(3),v(3),w(3)
3630 w(1)=u(2)*v(3)-u(3)*v(2)
3631 w(2)=-u(1)*v(3)+u(3)*v(1)
3632 w(3)=u(1)*v(2)-u(2)*v(1)
3635 C-----------------------------------------------------------------------------
3636 subroutine unormderiv(u,ugrad,unorm,ungrad)
3637 C This subroutine computes the derivatives of a normalized vector u, given
3638 C the derivatives computed without normalization conditions, ugrad. Returns
3641 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3642 double precision vec(3)
3643 double precision scalar
3645 c write (2,*) 'ugrad',ugrad
3648 vec(i)=scalar(ugrad(1,i),u(1))
3650 c write (2,*) 'vec',vec
3653 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3656 c write (2,*) 'ungrad',ungrad
3659 C-----------------------------------------------------------------------------
3660 subroutine escp(evdw2,evdw2_14)
3662 C This subroutine calculates the excluded-volume interaction energy between
3663 C peptide-group centers and side chains and its gradient in virtual-bond and
3664 C side-chain vectors.
3666 implicit real*8 (a-h,o-z)
3667 include 'DIMENSIONS'
3668 include 'DIMENSIONS.ZSCOPT'
3669 include 'COMMON.GEO'
3670 include 'COMMON.VAR'
3671 include 'COMMON.LOCAL'
3672 include 'COMMON.CHAIN'
3673 include 'COMMON.DERIV'
3674 include 'COMMON.INTERACT'
3675 include 'COMMON.FFIELD'
3676 include 'COMMON.IOUNITS'
3680 cd print '(a)','Enter ESCP'
3681 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3682 c & ' scal14',scal14
3683 do i=iatscp_s,iatscp_e
3684 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3686 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3687 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3688 if (iteli.eq.0) goto 1225
3689 xi=0.5D0*(c(1,i)+c(1,i+1))
3690 yi=0.5D0*(c(2,i)+c(2,i+1))
3691 zi=0.5D0*(c(3,i)+c(3,i+1))
3692 C Returning the ith atom to box
3694 if (xi.lt.0) xi=xi+boxxsize
3696 if (yi.lt.0) yi=yi+boxysize
3698 if (zi.lt.0) zi=zi+boxzsize
3699 do iint=1,nscp_gr(i)
3701 do j=iscpstart(i,iint),iscpend(i,iint)
3702 itypj=iabs(itype(j))
3703 if (itypj.eq.ntyp1) cycle
3704 C Uncomment following three lines for SC-p interactions
3708 C Uncomment following three lines for Ca-p interactions
3712 C returning the jth atom to box
3714 if (xj.lt.0) xj=xj+boxxsize
3716 if (yj.lt.0) yj=yj+boxysize
3718 if (zj.lt.0) zj=zj+boxzsize
3719 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3724 C Finding the closest jth atom
3728 xj=xj_safe+xshift*boxxsize
3729 yj=yj_safe+yshift*boxysize
3730 zj=zj_safe+zshift*boxzsize
3731 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3732 if(dist_temp.lt.dist_init) then
3742 if (subchap.eq.1) then
3751 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3752 C sss is scaling function for smoothing the cutoff gradient otherwise
3753 C the gradient would not be continuouse
3754 sss=sscale(1.0d0/(dsqrt(rrij)))
3755 if (sss.le.0.0d0) cycle
3756 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3758 e1=fac*fac*aad(itypj,iteli)
3759 e2=fac*bad(itypj,iteli)
3760 if (iabs(j-i) .le. 2) then
3763 evdw2_14=evdw2_14+(e1+e2)*sss
3766 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3767 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3768 c & bad(itypj,iteli)
3769 evdw2=evdw2+evdwij*sss
3772 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3774 fac=-(evdwij+e1)*rrij*sss
3775 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3780 cd write (iout,*) 'j<i'
3781 C Uncomment following three lines for SC-p interactions
3783 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3786 cd write (iout,*) 'j>i'
3789 C Uncomment following line for SC-p interactions
3790 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3794 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3798 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3799 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3802 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3812 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3813 gradx_scp(j,i)=expon*gradx_scp(j,i)
3816 C******************************************************************************
3820 C To save time the factor EXPON has been extracted from ALL components
3821 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3824 C******************************************************************************
3827 C--------------------------------------------------------------------------
3828 subroutine edis(ehpb)
3830 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3832 implicit real*8 (a-h,o-z)
3833 include 'DIMENSIONS'
3834 include 'DIMENSIONS.ZSCOPT'
3835 include 'COMMON.SBRIDGE'
3836 include 'COMMON.CHAIN'
3837 include 'COMMON.DERIV'
3838 include 'COMMON.VAR'
3839 include 'COMMON.INTERACT'
3840 include 'COMMON.CONTROL'
3841 include 'COMMON.IOUNITS'
3844 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3845 cd print *,'link_start=',link_start,' link_end=',link_end
3846 C write(iout,*) link_end, "link_end"
3847 if (link_end.eq.0) return
3848 do i=link_start,link_end
3849 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3850 C CA-CA distance used in regularization of structure.
3853 C iii and jjj point to the residues for which the distance is assigned.
3854 if (ii.gt.nres) then
3861 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3862 C distance and angle dependent SS bond potential.
3863 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3864 C & iabs(itype(jjj)).eq.1) then
3865 C write(iout,*) constr_dist,"const"
3866 if (.not.dyn_ss .and. i.le.nss) then
3867 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3868 & iabs(itype(jjj)).eq.1) then
3869 call ssbond_ene(iii,jjj,eij)
3872 else if (ii.gt.nres .and. jj.gt.nres) then
3873 c Restraints from contact prediction
3875 if (constr_dist.eq.11) then
3876 C ehpb=ehpb+fordepth(i)**4.0d0
3877 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3878 ehpb=ehpb+fordepth(i)**4.0d0
3879 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3880 fac=fordepth(i)**4.0d0
3881 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3882 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3883 C & ehpb,fordepth(i),dd
3884 C write(iout,*) ehpb,"atu?"
3886 C fac=fordepth(i)**4.0d0
3887 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3889 if (dhpb1(i).gt.0.0d0) then
3890 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3891 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3892 c write (iout,*) "beta nmr",
3893 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3897 C Get the force constant corresponding to this distance.
3899 C Calculate the contribution to energy.
3900 ehpb=ehpb+waga*rdis*rdis
3901 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3903 C Evaluate gradient.
3906 endif !end dhpb1(i).gt.0
3907 endif !end const_dist=11
3909 ggg(j)=fac*(c(j,jj)-c(j,ii))
3912 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3913 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3916 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3917 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3920 C write(iout,*) "before"
3922 C write(iout,*) "after",dd
3923 if (constr_dist.eq.11) then
3924 ehpb=ehpb+fordepth(i)**4.0d0
3925 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3926 fac=fordepth(i)**4.0d0
3927 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3928 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3929 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3930 C print *,ehpb,"tu?"
3931 C write(iout,*) ehpb,"btu?",
3932 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3933 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3934 C & ehpb,fordepth(i),dd
3936 if (dhpb1(i).gt.0.0d0) then
3937 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3938 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3939 c write (iout,*) "alph nmr",
3940 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3943 C Get the force constant corresponding to this distance.
3945 C Calculate the contribution to energy.
3946 ehpb=ehpb+waga*rdis*rdis
3947 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3949 C Evaluate gradient.
3956 ggg(j)=fac*(c(j,jj)-c(j,ii))
3958 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3959 C If this is a SC-SC distance, we need to calculate the contributions to the
3960 C Cartesian gradient in the SC vectors (ghpbx).
3963 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3964 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3969 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3974 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3977 C--------------------------------------------------------------------------
3978 subroutine ssbond_ene(i,j,eij)
3980 C Calculate the distance and angle dependent SS-bond potential energy
3981 C using a free-energy function derived based on RHF/6-31G** ab initio
3982 C calculations of diethyl disulfide.
3984 C A. Liwo and U. Kozlowska, 11/24/03
3986 implicit real*8 (a-h,o-z)
3987 include 'DIMENSIONS'
3988 include 'DIMENSIONS.ZSCOPT'
3989 include 'COMMON.SBRIDGE'
3990 include 'COMMON.CHAIN'
3991 include 'COMMON.DERIV'
3992 include 'COMMON.LOCAL'
3993 include 'COMMON.INTERACT'
3994 include 'COMMON.VAR'
3995 include 'COMMON.IOUNITS'
3996 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3997 itypi=iabs(itype(i))
4001 dxi=dc_norm(1,nres+i)
4002 dyi=dc_norm(2,nres+i)
4003 dzi=dc_norm(3,nres+i)
4004 dsci_inv=dsc_inv(itypi)
4005 itypj=iabs(itype(j))
4006 dscj_inv=dsc_inv(itypj)
4010 dxj=dc_norm(1,nres+j)
4011 dyj=dc_norm(2,nres+j)
4012 dzj=dc_norm(3,nres+j)
4013 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4018 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4019 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4020 om12=dxi*dxj+dyi*dyj+dzi*dzj
4022 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4023 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4029 deltat12=om2-om1+2.0d0
4031 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4032 & +akct*deltad*deltat12
4033 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4034 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4035 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4036 c & " deltat12",deltat12," eij",eij
4037 ed=2*akcm*deltad+akct*deltat12
4039 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4040 eom1=-2*akth*deltat1-pom1-om2*pom2
4041 eom2= 2*akth*deltat2+pom1-om1*pom2
4044 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4047 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4048 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4049 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4050 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4053 C Calculate the components of the gradient in DC and X
4057 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4062 C--------------------------------------------------------------------------
4063 subroutine ebond(estr)
4065 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4067 implicit real*8 (a-h,o-z)
4068 include 'DIMENSIONS'
4069 include 'DIMENSIONS.ZSCOPT'
4070 include 'COMMON.LOCAL'
4071 include 'COMMON.GEO'
4072 include 'COMMON.INTERACT'
4073 include 'COMMON.DERIV'
4074 include 'COMMON.VAR'
4075 include 'COMMON.CHAIN'
4076 include 'COMMON.IOUNITS'
4077 include 'COMMON.NAMES'
4078 include 'COMMON.FFIELD'
4079 include 'COMMON.CONTROL'
4080 logical energy_dec /.false./
4081 double precision u(3),ud(3)
4084 c write (iout,*) "distchainmax",distchainmax
4086 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4087 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4089 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4090 C & *dc(j,i-1)/vbld(i)
4092 C if (energy_dec) write(iout,*)
4093 C & "estr1",i,vbld(i),distchainmax,
4094 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4096 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4097 diff = vbld(i)-vbldpDUM
4098 C write(iout,*) i,diff
4100 diff = vbld(i)-vbldp0
4101 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4105 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4108 C write (iout,'(a7,i5,4f7.3)')
4109 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4111 estr=0.5d0*AKP*estr+estr1
4113 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4117 if (iti.ne.10 .and. iti.ne.ntyp1) then
4120 diff=vbld(i+nres)-vbldsc0(1,iti)
4121 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4122 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4123 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4125 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4129 diff=vbld(i+nres)-vbldsc0(j,iti)
4130 ud(j)=aksc(j,iti)*diff
4131 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4145 uprod2=uprod2*u(k)*u(k)
4149 usumsqder=usumsqder+ud(j)*uprod2
4151 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4152 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4153 estr=estr+uprod/usum
4155 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4163 C--------------------------------------------------------------------------
4164 subroutine ebend(etheta,ethetacnstr)
4166 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4167 C angles gamma and its derivatives in consecutive thetas and gammas.
4169 implicit real*8 (a-h,o-z)
4170 include 'DIMENSIONS'
4171 include 'DIMENSIONS.ZSCOPT'
4172 include 'COMMON.LOCAL'
4173 include 'COMMON.GEO'
4174 include 'COMMON.INTERACT'
4175 include 'COMMON.DERIV'
4176 include 'COMMON.VAR'
4177 include 'COMMON.CHAIN'
4178 include 'COMMON.IOUNITS'
4179 include 'COMMON.NAMES'
4180 include 'COMMON.FFIELD'
4181 include 'COMMON.TORCNSTR'
4182 common /calcthet/ term1,term2,termm,diffak,ratak,
4183 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4184 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4185 double precision y(2),z(2)
4187 c time11=dexp(-2*time)
4190 c write (iout,*) "nres",nres
4191 c write (*,'(a,i2)') 'EBEND ICG=',icg
4192 c write (iout,*) ithet_start,ithet_end
4193 do i=ithet_start,ithet_end
4194 C if (itype(i-1).eq.ntyp1) cycle
4196 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4197 & .or.itype(i).eq.ntyp1) cycle
4198 C Zero the energy function and its derivative at 0 or pi.
4199 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4201 ichir1=isign(1,itype(i-2))
4202 ichir2=isign(1,itype(i))
4203 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4204 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4205 if (itype(i-1).eq.10) then
4206 itype1=isign(10,itype(i-2))
4207 ichir11=isign(1,itype(i-2))
4208 ichir12=isign(1,itype(i-2))
4209 itype2=isign(10,itype(i))
4210 ichir21=isign(1,itype(i))
4211 ichir22=isign(1,itype(i))
4218 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4222 c call proc_proc(phii,icrc)
4223 if (icrc.eq.1) phii=150.0
4234 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4238 c call proc_proc(phii1,icrc)
4239 if (icrc.eq.1) phii1=150.0
4251 C Calculate the "mean" value of theta from the part of the distribution
4252 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4253 C In following comments this theta will be referred to as t_c.
4254 thet_pred_mean=0.0d0
4256 athetk=athet(k,it,ichir1,ichir2)
4257 bthetk=bthet(k,it,ichir1,ichir2)
4259 athetk=athet(k,itype1,ichir11,ichir12)
4260 bthetk=bthet(k,itype2,ichir21,ichir22)
4262 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4264 c write (iout,*) "thet_pred_mean",thet_pred_mean
4265 dthett=thet_pred_mean*ssd
4266 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4267 c write (iout,*) "thet_pred_mean",thet_pred_mean
4268 C Derivatives of the "mean" values in gamma1 and gamma2.
4269 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4270 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4271 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4272 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4274 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4275 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4276 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4277 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4279 if (theta(i).gt.pi-delta) then
4280 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4282 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4283 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4284 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4286 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4288 else if (theta(i).lt.delta) then
4289 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4290 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4291 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4293 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4294 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4297 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4300 etheta=etheta+ethetai
4301 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4302 c & 'ebend',i,ethetai,theta(i),itype(i)
4303 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4304 c & rad2deg*phii,rad2deg*phii1,ethetai
4305 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4306 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4307 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4311 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4312 do i=1,ntheta_constr
4313 itheta=itheta_constr(i)
4314 thetiii=theta(itheta)
4315 difi=pinorm(thetiii-theta_constr0(i))
4316 if (difi.gt.theta_drange(i)) then
4317 difi=difi-theta_drange(i)
4318 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4319 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4320 & +for_thet_constr(i)*difi**3
4321 else if (difi.lt.-drange(i)) then
4323 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4324 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4325 & +for_thet_constr(i)*difi**3
4329 C if (energy_dec) then
4330 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4331 C & i,itheta,rad2deg*thetiii,
4332 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4333 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4334 C & gloc(itheta+nphi-2,icg)
4337 C Ufff.... We've done all this!!!
4340 C---------------------------------------------------------------------------
4341 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4343 implicit real*8 (a-h,o-z)
4344 include 'DIMENSIONS'
4345 include 'COMMON.LOCAL'
4346 include 'COMMON.IOUNITS'
4347 common /calcthet/ term1,term2,termm,diffak,ratak,
4348 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4349 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4350 C Calculate the contributions to both Gaussian lobes.
4351 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4352 C The "polynomial part" of the "standard deviation" of this part of
4356 sig=sig*thet_pred_mean+polthet(j,it)
4358 C Derivative of the "interior part" of the "standard deviation of the"
4359 C gamma-dependent Gaussian lobe in t_c.
4360 sigtc=3*polthet(3,it)
4362 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4365 C Set the parameters of both Gaussian lobes of the distribution.
4366 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4367 fac=sig*sig+sigc0(it)
4370 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4371 sigsqtc=-4.0D0*sigcsq*sigtc
4372 c print *,i,sig,sigtc,sigsqtc
4373 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4374 sigtc=-sigtc/(fac*fac)
4375 C Following variable is sigma(t_c)**(-2)
4376 sigcsq=sigcsq*sigcsq
4378 sig0inv=1.0D0/sig0i**2
4379 delthec=thetai-thet_pred_mean
4380 delthe0=thetai-theta0i
4381 term1=-0.5D0*sigcsq*delthec*delthec
4382 term2=-0.5D0*sig0inv*delthe0*delthe0
4383 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4384 C NaNs in taking the logarithm. We extract the largest exponent which is added
4385 C to the energy (this being the log of the distribution) at the end of energy
4386 C term evaluation for this virtual-bond angle.
4387 if (term1.gt.term2) then
4389 term2=dexp(term2-termm)
4393 term1=dexp(term1-termm)
4396 C The ratio between the gamma-independent and gamma-dependent lobes of
4397 C the distribution is a Gaussian function of thet_pred_mean too.
4398 diffak=gthet(2,it)-thet_pred_mean
4399 ratak=diffak/gthet(3,it)**2
4400 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4401 C Let's differentiate it in thet_pred_mean NOW.
4403 C Now put together the distribution terms to make complete distribution.
4404 termexp=term1+ak*term2
4405 termpre=sigc+ak*sig0i
4406 C Contribution of the bending energy from this theta is just the -log of
4407 C the sum of the contributions from the two lobes and the pre-exponential
4408 C factor. Simple enough, isn't it?
4409 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4410 C NOW the derivatives!!!
4411 C 6/6/97 Take into account the deformation.
4412 E_theta=(delthec*sigcsq*term1
4413 & +ak*delthe0*sig0inv*term2)/termexp
4414 E_tc=((sigtc+aktc*sig0i)/termpre
4415 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4416 & aktc*term2)/termexp)
4419 c-----------------------------------------------------------------------------
4420 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4421 implicit real*8 (a-h,o-z)
4422 include 'DIMENSIONS'
4423 include 'COMMON.LOCAL'
4424 include 'COMMON.IOUNITS'
4425 common /calcthet/ term1,term2,termm,diffak,ratak,
4426 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4427 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4428 delthec=thetai-thet_pred_mean
4429 delthe0=thetai-theta0i
4430 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4431 t3 = thetai-thet_pred_mean
4435 t14 = t12+t6*sigsqtc
4437 t21 = thetai-theta0i
4443 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4444 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4445 & *(-t12*t9-ak*sig0inv*t27)
4449 C--------------------------------------------------------------------------
4450 subroutine ebend(etheta,ethetacnstr)
4452 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4453 C angles gamma and its derivatives in consecutive thetas and gammas.
4454 C ab initio-derived potentials from
4455 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4457 implicit real*8 (a-h,o-z)
4458 include 'DIMENSIONS'
4459 include 'DIMENSIONS.ZSCOPT'
4460 include 'COMMON.LOCAL'
4461 include 'COMMON.GEO'
4462 include 'COMMON.INTERACT'
4463 include 'COMMON.DERIV'
4464 include 'COMMON.VAR'
4465 include 'COMMON.CHAIN'
4466 include 'COMMON.IOUNITS'
4467 include 'COMMON.NAMES'
4468 include 'COMMON.FFIELD'
4469 include 'COMMON.CONTROL'
4470 include 'COMMON.TORCNSTR'
4471 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4472 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4473 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4474 & sinph1ph2(maxdouble,maxdouble)
4475 logical lprn /.false./, lprn1 /.false./
4477 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4478 do i=ithet_start,ithet_end
4480 C if (itype(i-1).eq.ntyp1) cycle
4482 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4483 & .or.itype(i).eq.ntyp1) cycle
4484 if (iabs(itype(i+1)).eq.20) iblock=2
4485 if (iabs(itype(i+1)).ne.20) iblock=1
4489 theti2=0.5d0*theta(i)
4490 ityp2=ithetyp((itype(i-1)))
4492 coskt(k)=dcos(k*theti2)
4493 sinkt(k)=dsin(k*theti2)
4503 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4506 if (phii.ne.phii) phii=150.0
4510 ityp1=ithetyp((itype(i-2)))
4512 cosph1(k)=dcos(k*phii)
4513 sinph1(k)=dsin(k*phii)
4519 ityp1=ithetyp((itype(i-2)))
4525 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4528 if (phii1.ne.phii1) phii1=150.0
4533 ityp3=ithetyp((itype(i)))
4535 cosph2(k)=dcos(k*phii1)
4536 sinph2(k)=dsin(k*phii1)
4541 ityp3=ithetyp((itype(i)))
4547 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4548 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4550 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4553 ccl=cosph1(l)*cosph2(k-l)
4554 ssl=sinph1(l)*sinph2(k-l)
4555 scl=sinph1(l)*cosph2(k-l)
4556 csl=cosph1(l)*sinph2(k-l)
4557 cosph1ph2(l,k)=ccl-ssl
4558 cosph1ph2(k,l)=ccl+ssl
4559 sinph1ph2(l,k)=scl+csl
4560 sinph1ph2(k,l)=scl-csl
4564 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4565 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4566 write (iout,*) "coskt and sinkt"
4568 write (iout,*) k,coskt(k),sinkt(k)
4572 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4573 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4576 & write (iout,*) "k",k,"
4577 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4578 & " ethetai",ethetai
4581 write (iout,*) "cosph and sinph"
4583 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4585 write (iout,*) "cosph1ph2 and sinph2ph2"
4588 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4589 & sinph1ph2(l,k),sinph1ph2(k,l)
4592 write(iout,*) "ethetai",ethetai
4596 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4597 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4598 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4599 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4600 ethetai=ethetai+sinkt(m)*aux
4601 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4602 dephii=dephii+k*sinkt(m)*(
4603 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4604 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4605 dephii1=dephii1+k*sinkt(m)*(
4606 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4607 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4609 & write (iout,*) "m",m," k",k," bbthet",
4610 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4611 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4612 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4613 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4617 & write(iout,*) "ethetai",ethetai
4621 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4622 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4623 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4624 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4625 ethetai=ethetai+sinkt(m)*aux
4626 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4627 dephii=dephii+l*sinkt(m)*(
4628 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4629 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4630 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4631 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4632 dephii1=dephii1+(k-l)*sinkt(m)*(
4633 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4634 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4635 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4636 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4638 write (iout,*) "m",m," k",k," l",l," ffthet",
4639 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4640 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4641 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4642 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4643 & " ethetai",ethetai
4644 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4645 & cosph1ph2(k,l)*sinkt(m),
4646 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4652 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4653 & i,theta(i)*rad2deg,phii*rad2deg,
4654 & phii1*rad2deg,ethetai
4655 etheta=etheta+ethetai
4656 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4657 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4658 c gloc(nphi+i-2,icg)=wang*dethetai
4659 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4663 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4664 do i=1,ntheta_constr
4665 itheta=itheta_constr(i)
4666 thetiii=theta(itheta)
4667 difi=pinorm(thetiii-theta_constr0(i))
4668 if (difi.gt.theta_drange(i)) then
4669 difi=difi-theta_drange(i)
4670 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4671 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4672 & +for_thet_constr(i)*difi**3
4673 else if (difi.lt.-drange(i)) then
4675 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4676 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4677 & +for_thet_constr(i)*difi**3
4681 C if (energy_dec) then
4682 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4683 C & i,itheta,rad2deg*thetiii,
4684 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4685 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4686 C & gloc(itheta+nphi-2,icg)
4693 c-----------------------------------------------------------------------------
4694 subroutine esc(escloc)
4695 C Calculate the local energy of a side chain and its derivatives in the
4696 C corresponding virtual-bond valence angles THETA and the spherical angles
4698 implicit real*8 (a-h,o-z)
4699 include 'DIMENSIONS'
4700 include 'DIMENSIONS.ZSCOPT'
4701 include 'COMMON.GEO'
4702 include 'COMMON.LOCAL'
4703 include 'COMMON.VAR'
4704 include 'COMMON.INTERACT'
4705 include 'COMMON.DERIV'
4706 include 'COMMON.CHAIN'
4707 include 'COMMON.IOUNITS'
4708 include 'COMMON.NAMES'
4709 include 'COMMON.FFIELD'
4710 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4711 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4712 common /sccalc/ time11,time12,time112,theti,it,nlobit
4715 C write (iout,*) 'ESC'
4716 do i=loc_start,loc_end
4718 if (it.eq.ntyp1) cycle
4719 if (it.eq.10) goto 1
4720 nlobit=nlob(iabs(it))
4721 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4722 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4723 theti=theta(i+1)-pipol
4727 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4729 if (x(2).gt.pi-delta) then
4733 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4735 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4736 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4738 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4739 & ddersc0(1),dersc(1))
4740 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4741 & ddersc0(3),dersc(3))
4743 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4745 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4746 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4747 & dersc0(2),esclocbi,dersc02)
4748 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4750 call splinthet(x(2),0.5d0*delta,ss,ssd)
4755 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4757 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4758 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4760 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4762 c write (iout,*) escloci
4763 else if (x(2).lt.delta) then
4767 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4769 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4770 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4772 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4773 & ddersc0(1),dersc(1))
4774 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4775 & ddersc0(3),dersc(3))
4777 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4779 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4780 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4781 & dersc0(2),esclocbi,dersc02)
4782 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4787 call splinthet(x(2),0.5d0*delta,ss,ssd)
4789 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4791 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4792 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4794 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4795 C write (iout,*) 'i=',i, escloci
4797 call enesc(x,escloci,dersc,ddummy,.false.)
4800 escloc=escloc+escloci
4801 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4802 write (iout,'(a6,i5,0pf7.3)')
4803 & 'escloc',i,escloci
4805 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4807 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4808 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4813 C---------------------------------------------------------------------------
4814 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4815 implicit real*8 (a-h,o-z)
4816 include 'DIMENSIONS'
4817 include 'COMMON.GEO'
4818 include 'COMMON.LOCAL'
4819 include 'COMMON.IOUNITS'
4820 common /sccalc/ time11,time12,time112,theti,it,nlobit
4821 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4822 double precision contr(maxlob,-1:1)
4824 c write (iout,*) 'it=',it,' nlobit=',nlobit
4828 if (mixed) ddersc(j)=0.0d0
4832 C Because of periodicity of the dependence of the SC energy in omega we have
4833 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4834 C To avoid underflows, first compute & store the exponents.
4842 z(k)=x(k)-censc(k,j,it)
4847 Axk=Axk+gaussc(l,k,j,it)*z(l)
4853 expfac=expfac+Ax(k,j,iii)*z(k)
4861 C As in the case of ebend, we want to avoid underflows in exponentiation and
4862 C subsequent NaNs and INFs in energy calculation.
4863 C Find the largest exponent
4867 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4871 cd print *,'it=',it,' emin=',emin
4873 C Compute the contribution to SC energy and derivatives
4877 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4878 cd print *,'j=',j,' expfac=',expfac
4879 escloc_i=escloc_i+expfac
4881 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4885 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4886 & +gaussc(k,2,j,it))*expfac
4893 dersc(1)=dersc(1)/cos(theti)**2
4894 ddersc(1)=ddersc(1)/cos(theti)**2
4897 escloci=-(dlog(escloc_i)-emin)
4899 dersc(j)=dersc(j)/escloc_i
4903 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4908 C------------------------------------------------------------------------------
4909 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4910 implicit real*8 (a-h,o-z)
4911 include 'DIMENSIONS'
4912 include 'COMMON.GEO'
4913 include 'COMMON.LOCAL'
4914 include 'COMMON.IOUNITS'
4915 common /sccalc/ time11,time12,time112,theti,it,nlobit
4916 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4917 double precision contr(maxlob)
4928 z(k)=x(k)-censc(k,j,it)
4934 Axk=Axk+gaussc(l,k,j,it)*z(l)
4940 expfac=expfac+Ax(k,j)*z(k)
4945 C As in the case of ebend, we want to avoid underflows in exponentiation and
4946 C subsequent NaNs and INFs in energy calculation.
4947 C Find the largest exponent
4950 if (emin.gt.contr(j)) emin=contr(j)
4954 C Compute the contribution to SC energy and derivatives
4958 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4959 escloc_i=escloc_i+expfac
4961 dersc(k)=dersc(k)+Ax(k,j)*expfac
4963 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4964 & +gaussc(1,2,j,it))*expfac
4968 dersc(1)=dersc(1)/cos(theti)**2
4969 dersc12=dersc12/cos(theti)**2
4970 escloci=-(dlog(escloc_i)-emin)
4972 dersc(j)=dersc(j)/escloc_i
4974 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4978 c----------------------------------------------------------------------------------
4979 subroutine esc(escloc)
4980 C Calculate the local energy of a side chain and its derivatives in the
4981 C corresponding virtual-bond valence angles THETA and the spherical angles
4982 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4983 C added by Urszula Kozlowska. 07/11/2007
4985 implicit real*8 (a-h,o-z)
4986 include 'DIMENSIONS'
4987 include 'DIMENSIONS.ZSCOPT'
4988 include 'COMMON.GEO'
4989 include 'COMMON.LOCAL'
4990 include 'COMMON.VAR'
4991 include 'COMMON.SCROT'
4992 include 'COMMON.INTERACT'
4993 include 'COMMON.DERIV'
4994 include 'COMMON.CHAIN'
4995 include 'COMMON.IOUNITS'
4996 include 'COMMON.NAMES'
4997 include 'COMMON.FFIELD'
4998 include 'COMMON.CONTROL'
4999 include 'COMMON.VECTORS'
5000 double precision x_prime(3),y_prime(3),z_prime(3)
5001 & , sumene,dsc_i,dp2_i,x(65),
5002 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5003 & de_dxx,de_dyy,de_dzz,de_dt
5004 double precision s1_t,s1_6_t,s2_t,s2_6_t
5006 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5007 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5008 & dt_dCi(3),dt_dCi1(3)
5009 common /sccalc/ time11,time12,time112,theti,it,nlobit
5012 do i=loc_start,loc_end
5013 if (itype(i).eq.ntyp1) cycle
5014 costtab(i+1) =dcos(theta(i+1))
5015 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5016 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5017 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5018 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5019 cosfac=dsqrt(cosfac2)
5020 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5021 sinfac=dsqrt(sinfac2)
5023 if (it.eq.10) goto 1
5025 C Compute the axes of tghe local cartesian coordinates system; store in
5026 c x_prime, y_prime and z_prime
5033 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5034 C & dc_norm(3,i+nres)
5036 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5037 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5040 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5043 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5044 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5045 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5046 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5047 c & " xy",scalar(x_prime(1),y_prime(1)),
5048 c & " xz",scalar(x_prime(1),z_prime(1)),
5049 c & " yy",scalar(y_prime(1),y_prime(1)),
5050 c & " yz",scalar(y_prime(1),z_prime(1)),
5051 c & " zz",scalar(z_prime(1),z_prime(1))
5053 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5054 C to local coordinate system. Store in xx, yy, zz.
5060 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5061 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5062 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5069 C Compute the energy of the ith side cbain
5071 c write (2,*) "xx",xx," yy",yy," zz",zz
5074 x(j) = sc_parmin(j,it)
5077 Cc diagnostics - remove later
5079 yy1 = dsin(alph(2))*dcos(omeg(2))
5080 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5081 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5082 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5084 C," --- ", xx_w,yy_w,zz_w
5087 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5088 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5090 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5091 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5093 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5094 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5095 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5096 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5097 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5099 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5100 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5101 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5102 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5103 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5105 dsc_i = 0.743d0+x(61)
5107 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5108 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5109 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5110 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5111 s1=(1+x(63))/(0.1d0 + dscp1)
5112 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5113 s2=(1+x(65))/(0.1d0 + dscp2)
5114 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5115 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5116 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5117 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5119 c & dscp1,dscp2,sumene
5120 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5121 escloc = escloc + sumene
5122 c write (2,*) "escloc",escloc
5123 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5125 if (.not. calc_grad) goto 1
5128 C This section to check the numerical derivatives of the energy of ith side
5129 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5130 C #define DEBUG in the code to turn it on.
5132 write (2,*) "sumene =",sumene
5136 write (2,*) xx,yy,zz
5137 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5138 de_dxx_num=(sumenep-sumene)/aincr
5140 write (2,*) "xx+ sumene from enesc=",sumenep
5143 write (2,*) xx,yy,zz
5144 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5145 de_dyy_num=(sumenep-sumene)/aincr
5147 write (2,*) "yy+ sumene from enesc=",sumenep
5150 write (2,*) xx,yy,zz
5151 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5152 de_dzz_num=(sumenep-sumene)/aincr
5154 write (2,*) "zz+ sumene from enesc=",sumenep
5155 costsave=cost2tab(i+1)
5156 sintsave=sint2tab(i+1)
5157 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5158 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5159 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5160 de_dt_num=(sumenep-sumene)/aincr
5161 write (2,*) " t+ sumene from enesc=",sumenep
5162 cost2tab(i+1)=costsave
5163 sint2tab(i+1)=sintsave
5164 C End of diagnostics section.
5167 C Compute the gradient of esc
5169 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5170 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5171 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5172 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5173 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5174 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5175 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5176 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5177 pom1=(sumene3*sint2tab(i+1)+sumene1)
5178 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5179 pom2=(sumene4*cost2tab(i+1)+sumene2)
5180 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5181 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5182 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5183 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5185 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5186 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5187 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5189 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5190 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5191 & +(pom1+pom2)*pom_dx
5193 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5196 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5197 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5198 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5200 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5201 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5202 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5203 & +x(59)*zz**2 +x(60)*xx*zz
5204 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5205 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5206 & +(pom1-pom2)*pom_dy
5208 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5211 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5212 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5213 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5214 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5215 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5216 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5217 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5218 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5220 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5223 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5224 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5225 & +pom1*pom_dt1+pom2*pom_dt2
5227 write(2,*), "de_dt = ", de_dt,de_dt_num
5231 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5232 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5233 cosfac2xx=cosfac2*xx
5234 sinfac2yy=sinfac2*yy
5236 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5238 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5240 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5241 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5242 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5243 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5244 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5245 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5246 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5247 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5248 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5249 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5253 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5254 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5255 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5256 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5259 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5260 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5261 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5263 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5264 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5268 dXX_Ctab(k,i)=dXX_Ci(k)
5269 dXX_C1tab(k,i)=dXX_Ci1(k)
5270 dYY_Ctab(k,i)=dYY_Ci(k)
5271 dYY_C1tab(k,i)=dYY_Ci1(k)
5272 dZZ_Ctab(k,i)=dZZ_Ci(k)
5273 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5274 dXX_XYZtab(k,i)=dXX_XYZ(k)
5275 dYY_XYZtab(k,i)=dYY_XYZ(k)
5276 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5280 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5281 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5282 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5283 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5284 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5286 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5287 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5288 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5289 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5290 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5291 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5292 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5293 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5295 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5296 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5298 C to check gradient call subroutine check_grad
5305 c------------------------------------------------------------------------------
5306 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5308 C This procedure calculates two-body contact function g(rij) and its derivative:
5311 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5314 C where x=(rij-r0ij)/delta
5316 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5319 double precision rij,r0ij,eps0ij,fcont,fprimcont
5320 double precision x,x2,x4,delta
5324 if (x.lt.-1.0D0) then
5327 else if (x.le.1.0D0) then
5330 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5331 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5338 c------------------------------------------------------------------------------
5339 subroutine splinthet(theti,delta,ss,ssder)
5340 implicit real*8 (a-h,o-z)
5341 include 'DIMENSIONS'
5342 include 'DIMENSIONS.ZSCOPT'
5343 include 'COMMON.VAR'
5344 include 'COMMON.GEO'
5347 if (theti.gt.pipol) then
5348 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5350 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5355 c------------------------------------------------------------------------------
5356 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5358 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5359 double precision ksi,ksi2,ksi3,a1,a2,a3
5360 a1=fprim0*delta/(f1-f0)
5366 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5367 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5370 c------------------------------------------------------------------------------
5371 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5373 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5374 double precision ksi,ksi2,ksi3,a1,a2,a3
5379 a2=3*(f1x-f0x)-2*fprim0x*delta
5380 a3=fprim0x*delta-2*(f1x-f0x)
5381 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5384 C-----------------------------------------------------------------------------
5386 C-----------------------------------------------------------------------------
5387 subroutine etor(etors,edihcnstr,fact)
5388 implicit real*8 (a-h,o-z)
5389 include 'DIMENSIONS'
5390 include 'DIMENSIONS.ZSCOPT'
5391 include 'COMMON.VAR'
5392 include 'COMMON.GEO'
5393 include 'COMMON.LOCAL'
5394 include 'COMMON.TORSION'
5395 include 'COMMON.INTERACT'
5396 include 'COMMON.DERIV'
5397 include 'COMMON.CHAIN'
5398 include 'COMMON.NAMES'
5399 include 'COMMON.IOUNITS'
5400 include 'COMMON.FFIELD'
5401 include 'COMMON.TORCNSTR'
5403 C Set lprn=.true. for debugging
5407 do i=iphi_start,iphi_end
5408 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5409 & .or. itype(i).eq.ntyp1) cycle
5410 itori=itortyp(itype(i-2))
5411 itori1=itortyp(itype(i-1))
5414 C Proline-Proline pair is a special case...
5415 if (itori.eq.3 .and. itori1.eq.3) then
5416 if (phii.gt.-dwapi3) then
5418 fac=1.0D0/(1.0D0-cosphi)
5419 etorsi=v1(1,3,3)*fac
5420 etorsi=etorsi+etorsi
5421 etors=etors+etorsi-v1(1,3,3)
5422 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5425 v1ij=v1(j+1,itori,itori1)
5426 v2ij=v2(j+1,itori,itori1)
5429 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5430 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5434 v1ij=v1(j,itori,itori1)
5435 v2ij=v2(j,itori,itori1)
5438 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5439 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5443 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5444 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5445 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5446 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5447 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5449 ! 6/20/98 - dihedral angle constraints
5452 itori=idih_constr(i)
5455 if (difi.gt.drange(i)) then
5457 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5458 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5459 else if (difi.lt.-drange(i)) then
5461 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5462 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5464 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5465 C & i,itori,rad2deg*phii,
5466 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5468 ! write (iout,*) 'edihcnstr',edihcnstr
5471 c------------------------------------------------------------------------------
5473 subroutine etor(etors,edihcnstr,fact)
5474 implicit real*8 (a-h,o-z)
5475 include 'DIMENSIONS'
5476 include 'DIMENSIONS.ZSCOPT'
5477 include 'COMMON.VAR'
5478 include 'COMMON.GEO'
5479 include 'COMMON.LOCAL'
5480 include 'COMMON.TORSION'
5481 include 'COMMON.INTERACT'
5482 include 'COMMON.DERIV'
5483 include 'COMMON.CHAIN'
5484 include 'COMMON.NAMES'
5485 include 'COMMON.IOUNITS'
5486 include 'COMMON.FFIELD'
5487 include 'COMMON.TORCNSTR'
5489 C Set lprn=.true. for debugging
5493 do i=iphi_start,iphi_end
5495 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5496 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5497 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5498 C & .or. itype(i).eq.ntyp1) cycle
5499 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5500 if (iabs(itype(i)).eq.20) then
5505 itori=itortyp(itype(i-2))
5506 itori1=itortyp(itype(i-1))
5509 C Regular cosine and sine terms
5510 do j=1,nterm(itori,itori1,iblock)
5511 v1ij=v1(j,itori,itori1,iblock)
5512 v2ij=v2(j,itori,itori1,iblock)
5515 etors=etors+v1ij*cosphi+v2ij*sinphi
5516 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5520 C E = SUM ----------------------------------- - v1
5521 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5523 cosphi=dcos(0.5d0*phii)
5524 sinphi=dsin(0.5d0*phii)
5525 do j=1,nlor(itori,itori1,iblock)
5526 vl1ij=vlor1(j,itori,itori1)
5527 vl2ij=vlor2(j,itori,itori1)
5528 vl3ij=vlor3(j,itori,itori1)
5529 pom=vl2ij*cosphi+vl3ij*sinphi
5530 pom1=1.0d0/(pom*pom+1.0d0)
5531 etors=etors+vl1ij*pom1
5532 c if (energy_dec) etors_ii=etors_ii+
5535 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5537 C Subtract the constant term
5538 etors=etors-v0(itori,itori1,iblock)
5540 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5541 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5542 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5543 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5544 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5547 ! 6/20/98 - dihedral angle constraints
5550 itori=idih_constr(i)
5552 difi=pinorm(phii-phi0(i))
5554 if (difi.gt.drange(i)) then
5556 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5557 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5558 edihi=0.25d0*ftors(i)*difi**4
5559 else if (difi.lt.-drange(i)) then
5561 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5562 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5563 edihi=0.25d0*ftors(i)*difi**4
5567 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5568 & i,itori,rad2deg*phii,
5569 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5570 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5572 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5573 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5575 ! write (iout,*) 'edihcnstr',edihcnstr
5578 c----------------------------------------------------------------------------
5579 subroutine etor_d(etors_d,fact2)
5580 C 6/23/01 Compute double torsional energy
5581 implicit real*8 (a-h,o-z)
5582 include 'DIMENSIONS'
5583 include 'DIMENSIONS.ZSCOPT'
5584 include 'COMMON.VAR'
5585 include 'COMMON.GEO'
5586 include 'COMMON.LOCAL'
5587 include 'COMMON.TORSION'
5588 include 'COMMON.INTERACT'
5589 include 'COMMON.DERIV'
5590 include 'COMMON.CHAIN'
5591 include 'COMMON.NAMES'
5592 include 'COMMON.IOUNITS'
5593 include 'COMMON.FFIELD'
5594 include 'COMMON.TORCNSTR'
5596 C Set lprn=.true. for debugging
5600 do i=iphi_start,iphi_end-1
5602 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5603 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5604 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5605 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5606 & (itype(i+1).eq.ntyp1)) cycle
5607 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5609 itori=itortyp(itype(i-2))
5610 itori1=itortyp(itype(i-1))
5611 itori2=itortyp(itype(i))
5617 if (iabs(itype(i+1)).eq.20) iblock=2
5618 C Regular cosine and sine terms
5619 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5620 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5621 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5622 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5623 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5624 cosphi1=dcos(j*phii)
5625 sinphi1=dsin(j*phii)
5626 cosphi2=dcos(j*phii1)
5627 sinphi2=dsin(j*phii1)
5628 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5629 & v2cij*cosphi2+v2sij*sinphi2
5630 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5631 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5633 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5635 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5636 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5637 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5638 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5639 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5640 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5641 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5642 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5643 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5644 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5645 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5646 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5647 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5648 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5651 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5652 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5658 c------------------------------------------------------------------------------
5659 subroutine eback_sc_corr(esccor)
5660 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5661 c conformational states; temporarily implemented as differences
5662 c between UNRES torsional potentials (dependent on three types of
5663 c residues) and the torsional potentials dependent on all 20 types
5664 c of residues computed from AM1 energy surfaces of terminally-blocked
5665 c amino-acid residues.
5666 implicit real*8 (a-h,o-z)
5667 include 'DIMENSIONS'
5668 include 'DIMENSIONS.ZSCOPT'
5669 include 'COMMON.VAR'
5670 include 'COMMON.GEO'
5671 include 'COMMON.LOCAL'
5672 include 'COMMON.TORSION'
5673 include 'COMMON.SCCOR'
5674 include 'COMMON.INTERACT'
5675 include 'COMMON.DERIV'
5676 include 'COMMON.CHAIN'
5677 include 'COMMON.NAMES'
5678 include 'COMMON.IOUNITS'
5679 include 'COMMON.FFIELD'
5680 include 'COMMON.CONTROL'
5682 C Set lprn=.true. for debugging
5685 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5687 do i=itau_start,itau_end
5688 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5690 isccori=isccortyp(itype(i-2))
5691 isccori1=isccortyp(itype(i-1))
5693 do intertyp=1,3 !intertyp
5694 cc Added 09 May 2012 (Adasko)
5695 cc Intertyp means interaction type of backbone mainchain correlation:
5696 c 1 = SC...Ca...Ca...Ca
5697 c 2 = Ca...Ca...Ca...SC
5698 c 3 = SC...Ca...Ca...SCi
5700 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5701 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5702 & (itype(i-1).eq.ntyp1)))
5703 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5704 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5705 & .or.(itype(i).eq.ntyp1)))
5706 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5707 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5708 & (itype(i-3).eq.ntyp1)))) cycle
5709 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5710 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5712 do j=1,nterm_sccor(isccori,isccori1)
5713 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5714 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5715 cosphi=dcos(j*tauangle(intertyp,i))
5716 sinphi=dsin(j*tauangle(intertyp,i))
5717 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5718 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5720 C write (iout,*)"EBACK_SC_COR",esccor,i
5721 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5722 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5723 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5725 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5726 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5727 & (v1sccor(j,1,itori,itori1),j=1,6)
5728 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5729 c gsccor_loc(i-3)=gloci
5734 c------------------------------------------------------------------------------
5735 subroutine multibody(ecorr)
5736 C This subroutine calculates multi-body contributions to energy following
5737 C the idea of Skolnick et al. If side chains I and J make a contact and
5738 C at the same time side chains I+1 and J+1 make a contact, an extra
5739 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5740 implicit real*8 (a-h,o-z)
5741 include 'DIMENSIONS'
5742 include 'COMMON.IOUNITS'
5743 include 'COMMON.DERIV'
5744 include 'COMMON.INTERACT'
5745 include 'COMMON.CONTACTS'
5746 double precision gx(3),gx1(3)
5749 C Set lprn=.true. for debugging
5753 write (iout,'(a)') 'Contact function values:'
5755 write (iout,'(i2,20(1x,i2,f10.5))')
5756 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5771 num_conti=num_cont(i)
5772 num_conti1=num_cont(i1)
5777 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5778 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5779 cd & ' ishift=',ishift
5780 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5781 C The system gains extra energy.
5782 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5783 endif ! j1==j+-ishift
5792 c------------------------------------------------------------------------------
5793 double precision function esccorr(i,j,k,l,jj,kk)
5794 implicit real*8 (a-h,o-z)
5795 include 'DIMENSIONS'
5796 include 'COMMON.IOUNITS'
5797 include 'COMMON.DERIV'
5798 include 'COMMON.INTERACT'
5799 include 'COMMON.CONTACTS'
5800 double precision gx(3),gx1(3)
5805 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5806 C Calculate the multi-body contribution to energy.
5807 C Calculate multi-body contributions to the gradient.
5808 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5809 cd & k,l,(gacont(m,kk,k),m=1,3)
5811 gx(m) =ekl*gacont(m,jj,i)
5812 gx1(m)=eij*gacont(m,kk,k)
5813 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5814 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5815 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5816 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5820 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5825 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5831 c------------------------------------------------------------------------------
5833 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5834 implicit real*8 (a-h,o-z)
5835 include 'DIMENSIONS'
5836 integer dimen1,dimen2,atom,indx
5837 double precision buffer(dimen1,dimen2)
5838 double precision zapas
5839 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5840 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5841 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5842 num_kont=num_cont_hb(atom)
5846 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5849 buffer(i,indx+22)=facont_hb(i,atom)
5850 buffer(i,indx+23)=ees0p(i,atom)
5851 buffer(i,indx+24)=ees0m(i,atom)
5852 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5854 buffer(1,indx+26)=dfloat(num_kont)
5857 c------------------------------------------------------------------------------
5858 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5859 implicit real*8 (a-h,o-z)
5860 include 'DIMENSIONS'
5861 integer dimen1,dimen2,atom,indx
5862 double precision buffer(dimen1,dimen2)
5863 double precision zapas
5864 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5865 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5866 & ees0m(ntyp,maxres),
5867 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5868 num_kont=buffer(1,indx+26)
5869 num_kont_old=num_cont_hb(atom)
5870 num_cont_hb(atom)=num_kont+num_kont_old
5875 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5878 facont_hb(ii,atom)=buffer(i,indx+22)
5879 ees0p(ii,atom)=buffer(i,indx+23)
5880 ees0m(ii,atom)=buffer(i,indx+24)
5881 jcont_hb(ii,atom)=buffer(i,indx+25)
5885 c------------------------------------------------------------------------------
5887 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5888 C This subroutine calculates multi-body contributions to hydrogen-bonding
5889 implicit real*8 (a-h,o-z)
5890 include 'DIMENSIONS'
5891 include 'DIMENSIONS.ZSCOPT'
5892 include 'COMMON.IOUNITS'
5894 include 'COMMON.INFO'
5896 include 'COMMON.FFIELD'
5897 include 'COMMON.DERIV'
5898 include 'COMMON.INTERACT'
5899 include 'COMMON.CONTACTS'
5901 parameter (max_cont=maxconts)
5902 parameter (max_dim=2*(8*3+2))
5903 parameter (msglen1=max_cont*max_dim*4)
5904 parameter (msglen2=2*msglen1)
5905 integer source,CorrelType,CorrelID,Error
5906 double precision buffer(max_cont,max_dim)
5908 double precision gx(3),gx1(3)
5911 C Set lprn=.true. for debugging
5916 if (fgProcs.le.1) goto 30
5918 write (iout,'(a)') 'Contact function values:'
5920 write (iout,'(2i3,50(1x,i2,f5.2))')
5921 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5922 & j=1,num_cont_hb(i))
5925 C Caution! Following code assumes that electrostatic interactions concerning
5926 C a given atom are split among at most two processors!
5936 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5939 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5940 if (MyRank.gt.0) then
5941 C Send correlation contributions to the preceding processor
5943 nn=num_cont_hb(iatel_s)
5944 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5945 cd write (iout,*) 'The BUFFER array:'
5947 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5949 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5951 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5952 C Clear the contacts of the atom passed to the neighboring processor
5953 nn=num_cont_hb(iatel_s+1)
5955 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5957 num_cont_hb(iatel_s)=0
5959 cd write (iout,*) 'Processor ',MyID,MyRank,
5960 cd & ' is sending correlation contribution to processor',MyID-1,
5961 cd & ' msglen=',msglen
5962 cd write (*,*) 'Processor ',MyID,MyRank,
5963 cd & ' is sending correlation contribution to processor',MyID-1,
5964 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5965 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5966 cd write (iout,*) 'Processor ',MyID,
5967 cd & ' has sent correlation contribution to processor',MyID-1,
5968 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5969 cd write (*,*) 'Processor ',MyID,
5970 cd & ' has sent correlation contribution to processor',MyID-1,
5971 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5973 endif ! (MyRank.gt.0)
5977 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5978 if (MyRank.lt.fgProcs-1) then
5979 C Receive correlation contributions from the next processor
5981 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5982 cd write (iout,*) 'Processor',MyID,
5983 cd & ' is receiving correlation contribution from processor',MyID+1,
5984 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5985 cd write (*,*) 'Processor',MyID,
5986 cd & ' is receiving correlation contribution from processor',MyID+1,
5987 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5989 do while (nbytes.le.0)
5990 call mp_probe(MyID+1,CorrelType,nbytes)
5992 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5993 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5994 cd write (iout,*) 'Processor',MyID,
5995 cd & ' has received correlation contribution from processor',MyID+1,
5996 cd & ' msglen=',msglen,' nbytes=',nbytes
5997 cd write (iout,*) 'The received BUFFER array:'
5999 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6001 if (msglen.eq.msglen1) then
6002 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6003 else if (msglen.eq.msglen2) then
6004 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6005 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6008 & 'ERROR!!!! message length changed while processing correlations.'
6010 & 'ERROR!!!! message length changed while processing correlations.'
6011 call mp_stopall(Error)
6012 endif ! msglen.eq.msglen1
6013 endif ! MyRank.lt.fgProcs-1
6020 write (iout,'(a)') 'Contact function values:'
6022 write (iout,'(2i3,50(1x,i2,f5.2))')
6023 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6024 & j=1,num_cont_hb(i))
6028 C Remove the loop below after debugging !!!
6035 C Calculate the local-electrostatic correlation terms
6036 do i=iatel_s,iatel_e+1
6038 num_conti=num_cont_hb(i)
6039 num_conti1=num_cont_hb(i+1)
6044 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6045 c & ' jj=',jj,' kk=',kk
6046 if (j1.eq.j+1 .or. j1.eq.j-1) then
6047 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6048 C The system gains extra energy.
6049 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6051 else if (j1.eq.j) then
6052 C Contacts I-J and I-(J+1) occur simultaneously.
6053 C The system loses extra energy.
6054 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6059 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6060 c & ' jj=',jj,' kk=',kk
6062 C Contacts I-J and (I+1)-J occur simultaneously.
6063 C The system loses extra energy.
6064 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6071 c------------------------------------------------------------------------------
6072 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6074 C This subroutine calculates multi-body contributions to hydrogen-bonding
6075 implicit real*8 (a-h,o-z)
6076 include 'DIMENSIONS'
6077 include 'DIMENSIONS.ZSCOPT'
6078 include 'COMMON.IOUNITS'
6080 include 'COMMON.INFO'
6082 include 'COMMON.FFIELD'
6083 include 'COMMON.DERIV'
6084 include 'COMMON.INTERACT'
6085 include 'COMMON.CONTACTS'
6087 parameter (max_cont=maxconts)
6088 parameter (max_dim=2*(8*3+2))
6089 parameter (msglen1=max_cont*max_dim*4)
6090 parameter (msglen2=2*msglen1)
6091 integer source,CorrelType,CorrelID,Error
6092 double precision buffer(max_cont,max_dim)
6094 double precision gx(3),gx1(3)
6097 C Set lprn=.true. for debugging
6104 if (fgProcs.le.1) goto 30
6106 write (iout,'(a)') 'Contact function values:'
6108 write (iout,'(2i3,50(1x,i2,f5.2))')
6109 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6110 & j=1,num_cont_hb(i))
6113 C Caution! Following code assumes that electrostatic interactions concerning
6114 C a given atom are split among at most two processors!
6124 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6127 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6128 if (MyRank.gt.0) then
6129 C Send correlation contributions to the preceding processor
6131 nn=num_cont_hb(iatel_s)
6132 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6133 cd write (iout,*) 'The BUFFER array:'
6135 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6137 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6139 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6140 C Clear the contacts of the atom passed to the neighboring processor
6141 nn=num_cont_hb(iatel_s+1)
6143 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6145 num_cont_hb(iatel_s)=0
6147 cd write (iout,*) 'Processor ',MyID,MyRank,
6148 cd & ' is sending correlation contribution to processor',MyID-1,
6149 cd & ' msglen=',msglen
6150 cd write (*,*) 'Processor ',MyID,MyRank,
6151 cd & ' is sending correlation contribution to processor',MyID-1,
6152 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6153 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6154 cd write (iout,*) 'Processor ',MyID,
6155 cd & ' has sent correlation contribution to processor',MyID-1,
6156 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6157 cd write (*,*) 'Processor ',MyID,
6158 cd & ' has sent correlation contribution to processor',MyID-1,
6159 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6161 endif ! (MyRank.gt.0)
6165 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6166 if (MyRank.lt.fgProcs-1) then
6167 C Receive correlation contributions from the next processor
6169 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6170 cd write (iout,*) 'Processor',MyID,
6171 cd & ' is receiving correlation contribution from processor',MyID+1,
6172 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6173 cd write (*,*) 'Processor',MyID,
6174 cd & ' is receiving correlation contribution from processor',MyID+1,
6175 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6177 do while (nbytes.le.0)
6178 call mp_probe(MyID+1,CorrelType,nbytes)
6180 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6181 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6182 cd write (iout,*) 'Processor',MyID,
6183 cd & ' has received correlation contribution from processor',MyID+1,
6184 cd & ' msglen=',msglen,' nbytes=',nbytes
6185 cd write (iout,*) 'The received BUFFER array:'
6187 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6189 if (msglen.eq.msglen1) then
6190 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6191 else if (msglen.eq.msglen2) then
6192 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6193 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6196 & 'ERROR!!!! message length changed while processing correlations.'
6198 & 'ERROR!!!! message length changed while processing correlations.'
6199 call mp_stopall(Error)
6200 endif ! msglen.eq.msglen1
6201 endif ! MyRank.lt.fgProcs-1
6208 write (iout,'(a)') 'Contact function values:'
6210 write (iout,'(2i3,50(1x,i2,f5.2))')
6211 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6212 & j=1,num_cont_hb(i))
6218 C Remove the loop below after debugging !!!
6225 C Calculate the dipole-dipole interaction energies
6226 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6227 do i=iatel_s,iatel_e+1
6228 num_conti=num_cont_hb(i)
6235 C Calculate the local-electrostatic correlation terms
6236 do i=iatel_s,iatel_e+1
6238 num_conti=num_cont_hb(i)
6239 num_conti1=num_cont_hb(i+1)
6244 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6245 c & ' jj=',jj,' kk=',kk
6246 if (j1.eq.j+1 .or. j1.eq.j-1) then
6247 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6248 C The system gains extra energy.
6250 sqd1=dsqrt(d_cont(jj,i))
6251 sqd2=dsqrt(d_cont(kk,i1))
6252 sred_geom = sqd1*sqd2
6253 IF (sred_geom.lt.cutoff_corr) THEN
6254 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6256 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6257 c & ' jj=',jj,' kk=',kk
6258 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6259 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6261 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6262 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6265 cd write (iout,*) 'sred_geom=',sred_geom,
6266 cd & ' ekont=',ekont,' fprim=',fprimcont
6267 call calc_eello(i,j,i+1,j1,jj,kk)
6268 if (wcorr4.gt.0.0d0)
6269 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6270 if (wcorr5.gt.0.0d0)
6271 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6272 c print *,"wcorr5",ecorr5
6273 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6274 cd write(2,*)'ijkl',i,j,i+1,j1
6275 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6276 & .or. wturn6.eq.0.0d0))then
6277 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6278 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6279 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6280 cd & 'ecorr6=',ecorr6
6281 cd write (iout,'(4e15.5)') sred_geom,
6282 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6283 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6284 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6285 else if (wturn6.gt.0.0d0
6286 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6287 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6288 eturn6=eturn6+eello_turn6(i,jj,kk)
6289 cd write (2,*) 'multibody_eello:eturn6',eturn6
6290 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6297 else if (j1.eq.j) then
6298 C Contacts I-J and I-(J+1) occur simultaneously.
6299 C The system loses extra energy.
6300 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6305 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6306 c & ' jj=',jj,' kk=',kk
6308 C Contacts I-J and (I+1)-J occur simultaneously.
6309 C The system loses extra energy.
6310 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6315 write (iout,*) "eturn6",eturn6,ecorr6
6318 c------------------------------------------------------------------------------
6319 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6320 implicit real*8 (a-h,o-z)
6321 include 'DIMENSIONS'
6322 include 'COMMON.IOUNITS'
6323 include 'COMMON.DERIV'
6324 include 'COMMON.INTERACT'
6325 include 'COMMON.CONTACTS'
6326 include 'COMMON.CONTROL'
6327 include 'COMMON.SHIELD'
6328 double precision gx(3),gx1(3)
6338 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6339 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6340 C Following 4 lines for diagnostics.
6345 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6347 c write (iout,*)'Contacts have occurred for peptide groups',
6348 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6349 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6350 C Calculate the multi-body contribution to energy.
6351 C ecorr=ecorr+ekont*ees
6353 C Calculate multi-body contributions to the gradient.
6355 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6356 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6357 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6358 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6359 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6360 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6361 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6362 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6363 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6364 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6365 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6366 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6367 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6368 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6372 gradcorr(ll,m)=gradcorr(ll,m)+
6373 & ees*ekl*gacont_hbr(ll,jj,i)-
6374 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6375 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6380 gradcorr(ll,m)=gradcorr(ll,m)+
6381 & ees*eij*gacont_hbr(ll,kk,k)-
6382 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6383 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6386 if (shield_mode.gt.0) then
6389 C print *,i,j,fac_shield(i),fac_shield(j),
6390 C &fac_shield(k),fac_shield(l)
6391 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6392 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6393 do ilist=1,ishield_list(i)
6394 iresshield=shield_list(ilist,i)
6396 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6398 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6400 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6401 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6405 do ilist=1,ishield_list(j)
6406 iresshield=shield_list(ilist,j)
6408 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6410 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6412 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6413 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6417 do ilist=1,ishield_list(k)
6418 iresshield=shield_list(ilist,k)
6420 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6422 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6424 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6425 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6429 do ilist=1,ishield_list(l)
6430 iresshield=shield_list(ilist,l)
6432 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6434 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6436 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6437 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6441 C print *,gshieldx(m,iresshield)
6443 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6444 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6445 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6446 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6447 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6448 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6449 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6450 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6452 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6453 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6454 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6455 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6456 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6457 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6458 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6459 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6468 C---------------------------------------------------------------------------
6469 subroutine dipole(i,j,jj)
6470 implicit real*8 (a-h,o-z)
6471 include 'DIMENSIONS'
6472 include 'DIMENSIONS.ZSCOPT'
6473 include 'COMMON.IOUNITS'
6474 include 'COMMON.CHAIN'
6475 include 'COMMON.FFIELD'
6476 include 'COMMON.DERIV'
6477 include 'COMMON.INTERACT'
6478 include 'COMMON.CONTACTS'
6479 include 'COMMON.TORSION'
6480 include 'COMMON.VAR'
6481 include 'COMMON.GEO'
6482 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6484 iti1 = itortyp(itype(i+1))
6485 if (j.lt.nres-1) then
6486 if (itype(j).le.ntyp) then
6487 itj1 = itortyp(itype(j+1))
6495 dipi(iii,1)=Ub2(iii,i)
6496 dipderi(iii)=Ub2der(iii,i)
6497 dipi(iii,2)=b1(iii,iti1)
6498 dipj(iii,1)=Ub2(iii,j)
6499 dipderj(iii)=Ub2der(iii,j)
6500 dipj(iii,2)=b1(iii,itj1)
6504 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6507 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6510 if (.not.calc_grad) return
6515 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6519 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6524 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6525 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6527 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6529 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6531 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6535 C---------------------------------------------------------------------------
6536 subroutine calc_eello(i,j,k,l,jj,kk)
6538 C This subroutine computes matrices and vectors needed to calculate
6539 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6541 implicit real*8 (a-h,o-z)
6542 include 'DIMENSIONS'
6543 include 'DIMENSIONS.ZSCOPT'
6544 include 'COMMON.IOUNITS'
6545 include 'COMMON.CHAIN'
6546 include 'COMMON.DERIV'
6547 include 'COMMON.INTERACT'
6548 include 'COMMON.CONTACTS'
6549 include 'COMMON.TORSION'
6550 include 'COMMON.VAR'
6551 include 'COMMON.GEO'
6552 include 'COMMON.FFIELD'
6553 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6554 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6557 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6558 cd & ' jj=',jj,' kk=',kk
6559 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6562 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6563 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6566 call transpose2(aa1(1,1),aa1t(1,1))
6567 call transpose2(aa2(1,1),aa2t(1,1))
6570 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6571 & aa1tder(1,1,lll,kkk))
6572 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6573 & aa2tder(1,1,lll,kkk))
6577 C parallel orientation of the two CA-CA-CA frames.
6578 if (i.gt.1 .and. itype(i).le.ntyp) then
6579 iti=itortyp(itype(i))
6583 itk1=itortyp(itype(k+1))
6584 itj=itortyp(itype(j))
6585 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6586 itl1=itortyp(itype(l+1))
6590 C A1 kernel(j+1) A2T
6592 cd write (iout,'(3f10.5,5x,3f10.5)')
6593 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6595 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6596 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6597 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6598 C Following matrices are needed only for 6-th order cumulants
6599 IF (wcorr6.gt.0.0d0) THEN
6600 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6601 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6602 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6603 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6604 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6605 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6606 & ADtEAderx(1,1,1,1,1,1))
6608 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6609 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6610 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6611 & ADtEA1derx(1,1,1,1,1,1))
6613 C End 6-th order cumulants
6616 cd write (2,*) 'In calc_eello6'
6618 cd write (2,*) 'iii=',iii
6620 cd write (2,*) 'kkk=',kkk
6622 cd write (2,'(3(2f10.5),5x)')
6623 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6628 call transpose2(EUgder(1,1,k),auxmat(1,1))
6629 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6630 call transpose2(EUg(1,1,k),auxmat(1,1))
6631 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6632 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6636 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6637 & EAEAderx(1,1,lll,kkk,iii,1))
6641 C A1T kernel(i+1) A2
6642 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6643 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6644 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6645 C Following matrices are needed only for 6-th order cumulants
6646 IF (wcorr6.gt.0.0d0) THEN
6647 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6648 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6649 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6650 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6651 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6652 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6653 & ADtEAderx(1,1,1,1,1,2))
6654 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6655 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6656 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6657 & ADtEA1derx(1,1,1,1,1,2))
6659 C End 6-th order cumulants
6660 call transpose2(EUgder(1,1,l),auxmat(1,1))
6661 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6662 call transpose2(EUg(1,1,l),auxmat(1,1))
6663 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6664 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6668 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6669 & EAEAderx(1,1,lll,kkk,iii,2))
6674 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6675 C They are needed only when the fifth- or the sixth-order cumulants are
6677 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6678 call transpose2(AEA(1,1,1),auxmat(1,1))
6679 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6680 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6681 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6682 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6683 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6684 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6685 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6686 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6687 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6688 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6689 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6690 call transpose2(AEA(1,1,2),auxmat(1,1))
6691 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6692 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6693 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6694 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6695 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6696 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6697 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6698 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6699 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6700 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6701 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6702 C Calculate the Cartesian derivatives of the vectors.
6706 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6707 call matvec2(auxmat(1,1),b1(1,iti),
6708 & AEAb1derx(1,lll,kkk,iii,1,1))
6709 call matvec2(auxmat(1,1),Ub2(1,i),
6710 & AEAb2derx(1,lll,kkk,iii,1,1))
6711 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6712 & AEAb1derx(1,lll,kkk,iii,2,1))
6713 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6714 & AEAb2derx(1,lll,kkk,iii,2,1))
6715 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6716 call matvec2(auxmat(1,1),b1(1,itj),
6717 & AEAb1derx(1,lll,kkk,iii,1,2))
6718 call matvec2(auxmat(1,1),Ub2(1,j),
6719 & AEAb2derx(1,lll,kkk,iii,1,2))
6720 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6721 & AEAb1derx(1,lll,kkk,iii,2,2))
6722 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6723 & AEAb2derx(1,lll,kkk,iii,2,2))
6730 C Antiparallel orientation of the two CA-CA-CA frames.
6731 if (i.gt.1 .and. itype(i).le.ntyp) then
6732 iti=itortyp(itype(i))
6736 itk1=itortyp(itype(k+1))
6737 itl=itortyp(itype(l))
6738 itj=itortyp(itype(j))
6739 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6740 itj1=itortyp(itype(j+1))
6744 C A2 kernel(j-1)T A1T
6745 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6746 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6747 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6748 C Following matrices are needed only for 6-th order cumulants
6749 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6750 & j.eq.i+4 .and. l.eq.i+3)) THEN
6751 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6752 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6753 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6754 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6755 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6756 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6757 & ADtEAderx(1,1,1,1,1,1))
6758 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6759 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6760 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6761 & ADtEA1derx(1,1,1,1,1,1))
6763 C End 6-th order cumulants
6764 call transpose2(EUgder(1,1,k),auxmat(1,1))
6765 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6766 call transpose2(EUg(1,1,k),auxmat(1,1))
6767 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6768 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6772 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6773 & EAEAderx(1,1,lll,kkk,iii,1))
6777 C A2T kernel(i+1)T A1
6778 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6779 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6780 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6781 C Following matrices are needed only for 6-th order cumulants
6782 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6783 & j.eq.i+4 .and. l.eq.i+3)) THEN
6784 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6785 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6786 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6787 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6788 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6789 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6790 & ADtEAderx(1,1,1,1,1,2))
6791 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6792 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6793 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6794 & ADtEA1derx(1,1,1,1,1,2))
6796 C End 6-th order cumulants
6797 call transpose2(EUgder(1,1,j),auxmat(1,1))
6798 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6799 call transpose2(EUg(1,1,j),auxmat(1,1))
6800 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6801 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6805 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6806 & EAEAderx(1,1,lll,kkk,iii,2))
6811 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6812 C They are needed only when the fifth- or the sixth-order cumulants are
6814 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6815 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6816 call transpose2(AEA(1,1,1),auxmat(1,1))
6817 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6818 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6819 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6820 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6821 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6822 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6823 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6824 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6825 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6826 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6827 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6828 call transpose2(AEA(1,1,2),auxmat(1,1))
6829 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6830 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6831 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6832 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6833 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6834 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6835 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6836 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6837 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6838 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6839 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6840 C Calculate the Cartesian derivatives of the vectors.
6844 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6845 call matvec2(auxmat(1,1),b1(1,iti),
6846 & AEAb1derx(1,lll,kkk,iii,1,1))
6847 call matvec2(auxmat(1,1),Ub2(1,i),
6848 & AEAb2derx(1,lll,kkk,iii,1,1))
6849 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6850 & AEAb1derx(1,lll,kkk,iii,2,1))
6851 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6852 & AEAb2derx(1,lll,kkk,iii,2,1))
6853 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6854 call matvec2(auxmat(1,1),b1(1,itl),
6855 & AEAb1derx(1,lll,kkk,iii,1,2))
6856 call matvec2(auxmat(1,1),Ub2(1,l),
6857 & AEAb2derx(1,lll,kkk,iii,1,2))
6858 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6859 & AEAb1derx(1,lll,kkk,iii,2,2))
6860 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6861 & AEAb2derx(1,lll,kkk,iii,2,2))
6870 C---------------------------------------------------------------------------
6871 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6872 & KK,KKderg,AKA,AKAderg,AKAderx)
6876 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6877 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6878 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6883 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6885 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6888 cd if (lprn) write (2,*) 'In kernel'
6890 cd if (lprn) write (2,*) 'kkk=',kkk
6892 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6893 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6895 cd write (2,*) 'lll=',lll
6896 cd write (2,*) 'iii=1'
6898 cd write (2,'(3(2f10.5),5x)')
6899 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6902 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6903 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6905 cd write (2,*) 'lll=',lll
6906 cd write (2,*) 'iii=2'
6908 cd write (2,'(3(2f10.5),5x)')
6909 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6916 C---------------------------------------------------------------------------
6917 double precision function eello4(i,j,k,l,jj,kk)
6918 implicit real*8 (a-h,o-z)
6919 include 'DIMENSIONS'
6920 include 'DIMENSIONS.ZSCOPT'
6921 include 'COMMON.IOUNITS'
6922 include 'COMMON.CHAIN'
6923 include 'COMMON.DERIV'
6924 include 'COMMON.INTERACT'
6925 include 'COMMON.CONTACTS'
6926 include 'COMMON.TORSION'
6927 include 'COMMON.VAR'
6928 include 'COMMON.GEO'
6929 double precision pizda(2,2),ggg1(3),ggg2(3)
6930 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6934 cd print *,'eello4:',i,j,k,l,jj,kk
6935 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6936 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6937 cold eij=facont_hb(jj,i)
6938 cold ekl=facont_hb(kk,k)
6940 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6942 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6943 gcorr_loc(k-1)=gcorr_loc(k-1)
6944 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6946 gcorr_loc(l-1)=gcorr_loc(l-1)
6947 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6949 gcorr_loc(j-1)=gcorr_loc(j-1)
6950 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6955 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6956 & -EAEAderx(2,2,lll,kkk,iii,1)
6957 cd derx(lll,kkk,iii)=0.0d0
6961 cd gcorr_loc(l-1)=0.0d0
6962 cd gcorr_loc(j-1)=0.0d0
6963 cd gcorr_loc(k-1)=0.0d0
6965 cd write (iout,*)'Contacts have occurred for peptide groups',
6966 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6967 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6968 if (j.lt.nres-1) then
6975 if (l.lt.nres-1) then
6983 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6984 ggg1(ll)=eel4*g_contij(ll,1)
6985 ggg2(ll)=eel4*g_contij(ll,2)
6986 ghalf=0.5d0*ggg1(ll)
6988 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6989 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6990 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6991 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6992 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6993 ghalf=0.5d0*ggg2(ll)
6995 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6996 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6997 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6998 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7003 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7004 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7009 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7010 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7016 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7021 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7025 cd write (2,*) iii,gcorr_loc(iii)
7029 cd write (2,*) 'ekont',ekont
7030 cd write (iout,*) 'eello4',ekont*eel4
7033 C---------------------------------------------------------------------------
7034 double precision function eello5(i,j,k,l,jj,kk)
7035 implicit real*8 (a-h,o-z)
7036 include 'DIMENSIONS'
7037 include 'DIMENSIONS.ZSCOPT'
7038 include 'COMMON.IOUNITS'
7039 include 'COMMON.CHAIN'
7040 include 'COMMON.DERIV'
7041 include 'COMMON.INTERACT'
7042 include 'COMMON.CONTACTS'
7043 include 'COMMON.TORSION'
7044 include 'COMMON.VAR'
7045 include 'COMMON.GEO'
7046 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7047 double precision ggg1(3),ggg2(3)
7048 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7053 C /l\ / \ \ / \ / \ / C
7054 C / \ / \ \ / \ / \ / C
7055 C j| o |l1 | o | o| o | | o |o C
7056 C \ |/k\| |/ \| / |/ \| |/ \| C
7057 C \i/ \ / \ / / \ / \ C
7059 C (I) (II) (III) (IV) C
7061 C eello5_1 eello5_2 eello5_3 eello5_4 C
7063 C Antiparallel chains C
7066 C /j\ / \ \ / \ / \ / C
7067 C / \ / \ \ / \ / \ / C
7068 C j1| o |l | o | o| o | | o |o C
7069 C \ |/k\| |/ \| / |/ \| |/ \| C
7070 C \i/ \ / \ / / \ / \ C
7072 C (I) (II) (III) (IV) C
7074 C eello5_1 eello5_2 eello5_3 eello5_4 C
7076 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7078 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7079 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7084 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7086 itk=itortyp(itype(k))
7087 itl=itortyp(itype(l))
7088 itj=itortyp(itype(j))
7093 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7094 cd & eel5_3_num,eel5_4_num)
7098 derx(lll,kkk,iii)=0.0d0
7102 cd eij=facont_hb(jj,i)
7103 cd ekl=facont_hb(kk,k)
7105 cd write (iout,*)'Contacts have occurred for peptide groups',
7106 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7108 C Contribution from the graph I.
7109 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7110 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7111 call transpose2(EUg(1,1,k),auxmat(1,1))
7112 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7113 vv(1)=pizda(1,1)-pizda(2,2)
7114 vv(2)=pizda(1,2)+pizda(2,1)
7115 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7116 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7118 C Explicit gradient in virtual-dihedral angles.
7119 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7120 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7121 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7122 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7123 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7124 vv(1)=pizda(1,1)-pizda(2,2)
7125 vv(2)=pizda(1,2)+pizda(2,1)
7126 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7127 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7128 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7129 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7130 vv(1)=pizda(1,1)-pizda(2,2)
7131 vv(2)=pizda(1,2)+pizda(2,1)
7133 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7134 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7135 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7137 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7138 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7139 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7141 C Cartesian gradient
7145 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7147 vv(1)=pizda(1,1)-pizda(2,2)
7148 vv(2)=pizda(1,2)+pizda(2,1)
7149 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7150 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7151 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7158 C Contribution from graph II
7159 call transpose2(EE(1,1,itk),auxmat(1,1))
7160 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7161 vv(1)=pizda(1,1)+pizda(2,2)
7162 vv(2)=pizda(2,1)-pizda(1,2)
7163 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7164 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7166 C Explicit gradient in virtual-dihedral angles.
7167 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7168 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7169 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7170 vv(1)=pizda(1,1)+pizda(2,2)
7171 vv(2)=pizda(2,1)-pizda(1,2)
7173 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7174 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7175 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7177 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7178 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7179 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7181 C Cartesian gradient
7185 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7187 vv(1)=pizda(1,1)+pizda(2,2)
7188 vv(2)=pizda(2,1)-pizda(1,2)
7189 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7190 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7191 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7200 C Parallel orientation
7201 C Contribution from graph III
7202 call transpose2(EUg(1,1,l),auxmat(1,1))
7203 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7204 vv(1)=pizda(1,1)-pizda(2,2)
7205 vv(2)=pizda(1,2)+pizda(2,1)
7206 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7207 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7209 C Explicit gradient in virtual-dihedral angles.
7210 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7211 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7212 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7213 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7214 vv(1)=pizda(1,1)-pizda(2,2)
7215 vv(2)=pizda(1,2)+pizda(2,1)
7216 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7217 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7218 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7219 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7220 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7221 vv(1)=pizda(1,1)-pizda(2,2)
7222 vv(2)=pizda(1,2)+pizda(2,1)
7223 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7224 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7225 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7226 C Cartesian gradient
7230 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7232 vv(1)=pizda(1,1)-pizda(2,2)
7233 vv(2)=pizda(1,2)+pizda(2,1)
7234 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7235 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7236 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7242 C Contribution from graph IV
7244 call transpose2(EE(1,1,itl),auxmat(1,1))
7245 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7246 vv(1)=pizda(1,1)+pizda(2,2)
7247 vv(2)=pizda(2,1)-pizda(1,2)
7248 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7249 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7251 C Explicit gradient in virtual-dihedral angles.
7252 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7253 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7254 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7255 vv(1)=pizda(1,1)+pizda(2,2)
7256 vv(2)=pizda(2,1)-pizda(1,2)
7257 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7258 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7259 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7260 C Cartesian gradient
7264 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7266 vv(1)=pizda(1,1)+pizda(2,2)
7267 vv(2)=pizda(2,1)-pizda(1,2)
7268 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7269 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7270 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7276 C Antiparallel orientation
7277 C Contribution from graph III
7279 call transpose2(EUg(1,1,j),auxmat(1,1))
7280 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7281 vv(1)=pizda(1,1)-pizda(2,2)
7282 vv(2)=pizda(1,2)+pizda(2,1)
7283 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7284 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7286 C Explicit gradient in virtual-dihedral angles.
7287 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7288 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7289 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7290 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7291 vv(1)=pizda(1,1)-pizda(2,2)
7292 vv(2)=pizda(1,2)+pizda(2,1)
7293 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7294 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7295 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7296 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7297 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7298 vv(1)=pizda(1,1)-pizda(2,2)
7299 vv(2)=pizda(1,2)+pizda(2,1)
7300 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7301 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7302 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7303 C Cartesian gradient
7307 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7309 vv(1)=pizda(1,1)-pizda(2,2)
7310 vv(2)=pizda(1,2)+pizda(2,1)
7311 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7312 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7313 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7319 C Contribution from graph IV
7321 call transpose2(EE(1,1,itj),auxmat(1,1))
7322 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7323 vv(1)=pizda(1,1)+pizda(2,2)
7324 vv(2)=pizda(2,1)-pizda(1,2)
7325 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7326 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7328 C Explicit gradient in virtual-dihedral angles.
7329 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7330 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7331 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7332 vv(1)=pizda(1,1)+pizda(2,2)
7333 vv(2)=pizda(2,1)-pizda(1,2)
7334 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7335 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7336 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7337 C Cartesian gradient
7341 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7343 vv(1)=pizda(1,1)+pizda(2,2)
7344 vv(2)=pizda(2,1)-pizda(1,2)
7345 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7346 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7347 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7354 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7355 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7356 cd write (2,*) 'ijkl',i,j,k,l
7357 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7358 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7360 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7361 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7362 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7363 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7365 if (j.lt.nres-1) then
7372 if (l.lt.nres-1) then
7382 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7384 ggg1(ll)=eel5*g_contij(ll,1)
7385 ggg2(ll)=eel5*g_contij(ll,2)
7386 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7387 ghalf=0.5d0*ggg1(ll)
7389 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7390 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7391 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7392 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7393 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7394 ghalf=0.5d0*ggg2(ll)
7396 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7397 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7398 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7399 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7404 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7405 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7410 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7411 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7417 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7422 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7426 cd write (2,*) iii,g_corr5_loc(iii)
7430 cd write (2,*) 'ekont',ekont
7431 cd write (iout,*) 'eello5',ekont*eel5
7434 c--------------------------------------------------------------------------
7435 double precision function eello6(i,j,k,l,jj,kk)
7436 implicit real*8 (a-h,o-z)
7437 include 'DIMENSIONS'
7438 include 'DIMENSIONS.ZSCOPT'
7439 include 'COMMON.IOUNITS'
7440 include 'COMMON.CHAIN'
7441 include 'COMMON.DERIV'
7442 include 'COMMON.INTERACT'
7443 include 'COMMON.CONTACTS'
7444 include 'COMMON.TORSION'
7445 include 'COMMON.VAR'
7446 include 'COMMON.GEO'
7447 include 'COMMON.FFIELD'
7448 double precision ggg1(3),ggg2(3)
7449 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7454 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7462 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7463 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7467 derx(lll,kkk,iii)=0.0d0
7471 cd eij=facont_hb(jj,i)
7472 cd ekl=facont_hb(kk,k)
7478 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7479 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7480 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7481 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7482 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7483 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7485 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7486 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7487 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7488 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7489 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7490 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7494 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7496 C If turn contributions are considered, they will be handled separately.
7497 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7498 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7499 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7500 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7501 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7502 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7503 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7506 if (j.lt.nres-1) then
7513 if (l.lt.nres-1) then
7521 ggg1(ll)=eel6*g_contij(ll,1)
7522 ggg2(ll)=eel6*g_contij(ll,2)
7523 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7524 ghalf=0.5d0*ggg1(ll)
7526 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7527 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7528 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7529 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7530 ghalf=0.5d0*ggg2(ll)
7531 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7533 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7534 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7535 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7536 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7541 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7542 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7547 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7548 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7554 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7559 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7563 cd write (2,*) iii,g_corr6_loc(iii)
7567 cd write (2,*) 'ekont',ekont
7568 cd write (iout,*) 'eello6',ekont*eel6
7571 c--------------------------------------------------------------------------
7572 double precision function eello6_graph1(i,j,k,l,imat,swap)
7573 implicit real*8 (a-h,o-z)
7574 include 'DIMENSIONS'
7575 include 'DIMENSIONS.ZSCOPT'
7576 include 'COMMON.IOUNITS'
7577 include 'COMMON.CHAIN'
7578 include 'COMMON.DERIV'
7579 include 'COMMON.INTERACT'
7580 include 'COMMON.CONTACTS'
7581 include 'COMMON.TORSION'
7582 include 'COMMON.VAR'
7583 include 'COMMON.GEO'
7584 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7588 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7590 C Parallel Antiparallel C
7596 C \ j|/k\| / \ |/k\|l / C
7601 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7602 itk=itortyp(itype(k))
7603 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7604 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7605 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7606 call transpose2(EUgC(1,1,k),auxmat(1,1))
7607 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7608 vv1(1)=pizda1(1,1)-pizda1(2,2)
7609 vv1(2)=pizda1(1,2)+pizda1(2,1)
7610 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7611 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7612 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7613 s5=scalar2(vv(1),Dtobr2(1,i))
7614 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7615 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7616 if (.not. calc_grad) return
7617 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7618 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7619 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7620 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7621 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7622 & +scalar2(vv(1),Dtobr2der(1,i)))
7623 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7624 vv1(1)=pizda1(1,1)-pizda1(2,2)
7625 vv1(2)=pizda1(1,2)+pizda1(2,1)
7626 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7627 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7629 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7630 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7631 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7632 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7633 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7635 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7636 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7637 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7638 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7639 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7641 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7642 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7643 vv1(1)=pizda1(1,1)-pizda1(2,2)
7644 vv1(2)=pizda1(1,2)+pizda1(2,1)
7645 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7646 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7647 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7648 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7657 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7658 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7659 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7660 call transpose2(EUgC(1,1,k),auxmat(1,1))
7661 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7663 vv1(1)=pizda1(1,1)-pizda1(2,2)
7664 vv1(2)=pizda1(1,2)+pizda1(2,1)
7665 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7666 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7667 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7668 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7669 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7670 s5=scalar2(vv(1),Dtobr2(1,i))
7671 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7677 c----------------------------------------------------------------------------
7678 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7679 implicit real*8 (a-h,o-z)
7680 include 'DIMENSIONS'
7681 include 'DIMENSIONS.ZSCOPT'
7682 include 'COMMON.IOUNITS'
7683 include 'COMMON.CHAIN'
7684 include 'COMMON.DERIV'
7685 include 'COMMON.INTERACT'
7686 include 'COMMON.CONTACTS'
7687 include 'COMMON.TORSION'
7688 include 'COMMON.VAR'
7689 include 'COMMON.GEO'
7691 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7692 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7695 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7697 C Parallel Antiparallel C
7703 C \ j|/k\| \ |/k\|l C
7708 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7709 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7710 C AL 7/4/01 s1 would occur in the sixth-order moment,
7711 C but not in a cluster cumulant
7713 s1=dip(1,jj,i)*dip(1,kk,k)
7715 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7716 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7717 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7718 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7719 call transpose2(EUg(1,1,k),auxmat(1,1))
7720 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7721 vv(1)=pizda(1,1)-pizda(2,2)
7722 vv(2)=pizda(1,2)+pizda(2,1)
7723 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7724 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7726 eello6_graph2=-(s1+s2+s3+s4)
7728 eello6_graph2=-(s2+s3+s4)
7731 if (.not. calc_grad) return
7732 C Derivatives in gamma(i-1)
7735 s1=dipderg(1,jj,i)*dip(1,kk,k)
7737 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7738 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7739 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7740 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7742 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7744 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7746 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7748 C Derivatives in gamma(k-1)
7750 s1=dip(1,jj,i)*dipderg(1,kk,k)
7752 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7753 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7754 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7755 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7756 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7757 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7758 vv(1)=pizda(1,1)-pizda(2,2)
7759 vv(2)=pizda(1,2)+pizda(2,1)
7760 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7762 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7764 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7766 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7767 C Derivatives in gamma(j-1) or gamma(l-1)
7770 s1=dipderg(3,jj,i)*dip(1,kk,k)
7772 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7773 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7774 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7775 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7776 vv(1)=pizda(1,1)-pizda(2,2)
7777 vv(2)=pizda(1,2)+pizda(2,1)
7778 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7781 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7783 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7786 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7787 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7789 C Derivatives in gamma(l-1) or gamma(j-1)
7792 s1=dip(1,jj,i)*dipderg(3,kk,k)
7794 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7795 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7796 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7797 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7798 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7799 vv(1)=pizda(1,1)-pizda(2,2)
7800 vv(2)=pizda(1,2)+pizda(2,1)
7801 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7804 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7806 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7809 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7810 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7812 C Cartesian derivatives.
7814 write (2,*) 'In eello6_graph2'
7816 write (2,*) 'iii=',iii
7818 write (2,*) 'kkk=',kkk
7820 write (2,'(3(2f10.5),5x)')
7821 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7831 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7833 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7836 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7838 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7839 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7841 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7842 call transpose2(EUg(1,1,k),auxmat(1,1))
7843 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7845 vv(1)=pizda(1,1)-pizda(2,2)
7846 vv(2)=pizda(1,2)+pizda(2,1)
7847 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7848 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7850 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7852 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7855 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7857 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7864 c----------------------------------------------------------------------------
7865 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7866 implicit real*8 (a-h,o-z)
7867 include 'DIMENSIONS'
7868 include 'DIMENSIONS.ZSCOPT'
7869 include 'COMMON.IOUNITS'
7870 include 'COMMON.CHAIN'
7871 include 'COMMON.DERIV'
7872 include 'COMMON.INTERACT'
7873 include 'COMMON.CONTACTS'
7874 include 'COMMON.TORSION'
7875 include 'COMMON.VAR'
7876 include 'COMMON.GEO'
7877 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7879 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7881 C Parallel Antiparallel C
7887 C j|/k\| / |/k\|l / C
7892 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7894 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7895 C energy moment and not to the cluster cumulant.
7896 iti=itortyp(itype(i))
7897 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7898 itj1=itortyp(itype(j+1))
7902 itk=itortyp(itype(k))
7903 itk1=itortyp(itype(k+1))
7904 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7905 itl1=itortyp(itype(l+1))
7910 s1=dip(4,jj,i)*dip(4,kk,k)
7912 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7913 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7914 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7915 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7916 call transpose2(EE(1,1,itk),auxmat(1,1))
7917 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7918 vv(1)=pizda(1,1)+pizda(2,2)
7919 vv(2)=pizda(2,1)-pizda(1,2)
7920 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7921 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7923 eello6_graph3=-(s1+s2+s3+s4)
7925 eello6_graph3=-(s2+s3+s4)
7928 if (.not. calc_grad) return
7929 C Derivatives in gamma(k-1)
7930 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7931 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7932 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7933 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7934 C Derivatives in gamma(l-1)
7935 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7936 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7937 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7938 vv(1)=pizda(1,1)+pizda(2,2)
7939 vv(2)=pizda(2,1)-pizda(1,2)
7940 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7941 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7942 C Cartesian derivatives.
7948 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7950 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7953 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7955 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7956 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7958 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7959 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7961 vv(1)=pizda(1,1)+pizda(2,2)
7962 vv(2)=pizda(2,1)-pizda(1,2)
7963 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7965 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7967 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7970 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7972 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7974 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7980 c----------------------------------------------------------------------------
7981 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7982 implicit real*8 (a-h,o-z)
7983 include 'DIMENSIONS'
7984 include 'DIMENSIONS.ZSCOPT'
7985 include 'COMMON.IOUNITS'
7986 include 'COMMON.CHAIN'
7987 include 'COMMON.DERIV'
7988 include 'COMMON.INTERACT'
7989 include 'COMMON.CONTACTS'
7990 include 'COMMON.TORSION'
7991 include 'COMMON.VAR'
7992 include 'COMMON.GEO'
7993 include 'COMMON.FFIELD'
7994 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7995 & auxvec1(2),auxmat1(2,2)
7997 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7999 C Parallel Antiparallel C
8005 C \ j|/k\| \ |/k\|l C
8010 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8012 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8013 C energy moment and not to the cluster cumulant.
8014 cd write (2,*) 'eello_graph4: wturn6',wturn6
8015 iti=itortyp(itype(i))
8016 itj=itortyp(itype(j))
8017 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
8018 itj1=itortyp(itype(j+1))
8022 itk=itortyp(itype(k))
8023 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
8024 itk1=itortyp(itype(k+1))
8028 itl=itortyp(itype(l))
8029 if (l.lt.nres-1) then
8030 itl1=itortyp(itype(l+1))
8034 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8035 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8036 cd & ' itl',itl,' itl1',itl1
8039 s1=dip(3,jj,i)*dip(3,kk,k)
8041 s1=dip(2,jj,j)*dip(2,kk,l)
8044 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8045 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8047 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8048 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8050 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8051 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8053 call transpose2(EUg(1,1,k),auxmat(1,1))
8054 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8055 vv(1)=pizda(1,1)-pizda(2,2)
8056 vv(2)=pizda(2,1)+pizda(1,2)
8057 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8058 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8060 eello6_graph4=-(s1+s2+s3+s4)
8062 eello6_graph4=-(s2+s3+s4)
8064 if (.not. calc_grad) return
8065 C Derivatives in gamma(i-1)
8069 s1=dipderg(2,jj,i)*dip(3,kk,k)
8071 s1=dipderg(4,jj,j)*dip(2,kk,l)
8074 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8076 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8077 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8079 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8080 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8082 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8083 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8084 cd write (2,*) 'turn6 derivatives'
8086 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8088 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8092 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8094 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8098 C Derivatives in gamma(k-1)
8101 s1=dip(3,jj,i)*dipderg(2,kk,k)
8103 s1=dip(2,jj,j)*dipderg(4,kk,l)
8106 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8107 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8109 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8110 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8112 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8113 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8115 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8116 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8117 vv(1)=pizda(1,1)-pizda(2,2)
8118 vv(2)=pizda(2,1)+pizda(1,2)
8119 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8120 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8122 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8124 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8128 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8130 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8133 C Derivatives in gamma(j-1) or gamma(l-1)
8134 if (l.eq.j+1 .and. l.gt.1) then
8135 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8136 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8137 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8138 vv(1)=pizda(1,1)-pizda(2,2)
8139 vv(2)=pizda(2,1)+pizda(1,2)
8140 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8141 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8142 else if (j.gt.1) then
8143 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8144 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8145 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8146 vv(1)=pizda(1,1)-pizda(2,2)
8147 vv(2)=pizda(2,1)+pizda(1,2)
8148 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8149 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8150 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8152 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8155 C Cartesian derivatives.
8162 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8164 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8168 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8170 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8174 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8176 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8178 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8179 & b1(1,itj1),auxvec(1))
8180 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8182 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8183 & b1(1,itl1),auxvec(1))
8184 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8186 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8188 vv(1)=pizda(1,1)-pizda(2,2)
8189 vv(2)=pizda(2,1)+pizda(1,2)
8190 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8192 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8194 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8197 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8200 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8203 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8205 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8207 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8211 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8213 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8216 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8218 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8226 c----------------------------------------------------------------------------
8227 double precision function eello_turn6(i,jj,kk)
8228 implicit real*8 (a-h,o-z)
8229 include 'DIMENSIONS'
8230 include 'DIMENSIONS.ZSCOPT'
8231 include 'COMMON.IOUNITS'
8232 include 'COMMON.CHAIN'
8233 include 'COMMON.DERIV'
8234 include 'COMMON.INTERACT'
8235 include 'COMMON.CONTACTS'
8236 include 'COMMON.TORSION'
8237 include 'COMMON.VAR'
8238 include 'COMMON.GEO'
8239 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8240 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8242 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8243 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8244 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8245 C the respective energy moment and not to the cluster cumulant.
8250 iti=itortyp(itype(i))
8251 itk=itortyp(itype(k))
8252 itk1=itortyp(itype(k+1))
8253 itl=itortyp(itype(l))
8254 itj=itortyp(itype(j))
8255 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8256 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8257 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8262 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8264 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8268 derx_turn(lll,kkk,iii)=0.0d0
8275 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8277 cd write (2,*) 'eello6_5',eello6_5
8279 call transpose2(AEA(1,1,1),auxmat(1,1))
8280 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8281 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8282 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8286 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8287 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8288 s2 = scalar2(b1(1,itk),vtemp1(1))
8290 call transpose2(AEA(1,1,2),atemp(1,1))
8291 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8292 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8293 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8297 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8298 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8299 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8301 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8302 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8303 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8304 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8305 ss13 = scalar2(b1(1,itk),vtemp4(1))
8306 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8310 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8316 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8318 C Derivatives in gamma(i+2)
8320 call transpose2(AEA(1,1,1),auxmatd(1,1))
8321 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8322 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8323 call transpose2(AEAderg(1,1,2),atempd(1,1))
8324 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8325 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8329 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8330 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8331 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8337 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8338 C Derivatives in gamma(i+3)
8340 call transpose2(AEA(1,1,1),auxmatd(1,1))
8341 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8342 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8343 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8347 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8348 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8349 s2d = scalar2(b1(1,itk),vtemp1d(1))
8351 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8352 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8354 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8356 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8357 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8358 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8368 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8369 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8371 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8372 & -0.5d0*ekont*(s2d+s12d)
8374 C Derivatives in gamma(i+4)
8375 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8376 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8377 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8379 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8380 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8381 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8391 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8393 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8395 C Derivatives in gamma(i+5)
8397 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8398 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8399 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8403 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8404 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8405 s2d = scalar2(b1(1,itk),vtemp1d(1))
8407 call transpose2(AEA(1,1,2),atempd(1,1))
8408 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8409 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8413 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8414 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8416 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8417 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8418 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8428 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8429 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8431 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8432 & -0.5d0*ekont*(s2d+s12d)
8434 C Cartesian derivatives
8439 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8440 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8441 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8445 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8446 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8448 s2d = scalar2(b1(1,itk),vtemp1d(1))
8450 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8451 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8452 s8d = -(atempd(1,1)+atempd(2,2))*
8453 & scalar2(cc(1,1,itl),vtemp2(1))
8457 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8459 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8460 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8467 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8470 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8474 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8475 & - 0.5d0*(s8d+s12d)
8477 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8486 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8488 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8489 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8490 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8491 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8492 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8494 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8495 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8496 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8500 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8501 cd & 16*eel_turn6_num
8503 if (j.lt.nres-1) then
8510 if (l.lt.nres-1) then
8518 ggg1(ll)=eel_turn6*g_contij(ll,1)
8519 ggg2(ll)=eel_turn6*g_contij(ll,2)
8520 ghalf=0.5d0*ggg1(ll)
8522 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8523 & +ekont*derx_turn(ll,2,1)
8524 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8525 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8526 & +ekont*derx_turn(ll,4,1)
8527 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8528 ghalf=0.5d0*ggg2(ll)
8530 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8531 & +ekont*derx_turn(ll,2,2)
8532 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8533 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8534 & +ekont*derx_turn(ll,4,2)
8535 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8540 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8545 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8551 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8556 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8560 cd write (2,*) iii,g_corr6_loc(iii)
8563 eello_turn6=ekont*eel_turn6
8564 cd write (2,*) 'ekont',ekont
8565 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8568 crc-------------------------------------------------
8569 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8570 subroutine Eliptransfer(eliptran)
8571 implicit real*8 (a-h,o-z)
8572 include 'DIMENSIONS'
8573 include 'COMMON.GEO'
8574 include 'COMMON.VAR'
8575 include 'COMMON.LOCAL'
8576 include 'COMMON.CHAIN'
8577 include 'COMMON.DERIV'
8578 include 'COMMON.INTERACT'
8579 include 'COMMON.IOUNITS'
8580 include 'COMMON.CALC'
8581 include 'COMMON.CONTROL'
8582 include 'COMMON.SPLITELE'
8583 include 'COMMON.SBRIDGE'
8584 C this is done by Adasko
8588 C--bordliptop-- buffore starts
8589 C--bufliptop--- here true lipid starts
8591 C--buflipbot--- lipid ends buffore starts
8592 C--bordlipbot--buffore ends
8596 if (itype(i).eq.ntyp1) cycle
8598 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8599 if (positi.le.0) positi=positi+boxzsize
8601 C first for peptide groups
8602 c for each residue check if it is in lipid or lipid water border area
8603 if ((positi.gt.bordlipbot)
8604 &.and.(positi.lt.bordliptop)) then
8605 C the energy transfer exist
8606 if (positi.lt.buflipbot) then
8607 C what fraction I am in
8609 & ((positi-bordlipbot)/lipbufthick)
8610 C lipbufthick is thickenes of lipid buffore
8611 sslip=sscalelip(fracinbuf)
8612 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8613 eliptran=eliptran+sslip*pepliptran
8614 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8615 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8616 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8617 elseif (positi.gt.bufliptop) then
8618 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8619 sslip=sscalelip(fracinbuf)
8620 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8621 eliptran=eliptran+sslip*pepliptran
8622 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8623 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8624 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8625 C print *, "doing sscalefor top part"
8626 C print *,i,sslip,fracinbuf,ssgradlip
8628 eliptran=eliptran+pepliptran
8629 C print *,"I am in true lipid"
8632 C eliptran=elpitran+0.0 ! I am in water
8635 C print *, "nic nie bylo w lipidzie?"
8636 C now multiply all by the peptide group transfer factor
8637 C eliptran=eliptran*pepliptran
8638 C now the same for side chains
8641 if (itype(i).eq.ntyp1) cycle
8642 positi=(mod(c(3,i+nres),boxzsize))
8643 if (positi.le.0) positi=positi+boxzsize
8644 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8645 c for each residue check if it is in lipid or lipid water border area
8646 C respos=mod(c(3,i+nres),boxzsize)
8647 C print *,positi,bordlipbot,buflipbot
8648 if ((positi.gt.bordlipbot)
8649 & .and.(positi.lt.bordliptop)) then
8650 C the energy transfer exist
8651 if (positi.lt.buflipbot) then
8653 & ((positi-bordlipbot)/lipbufthick)
8654 C lipbufthick is thickenes of lipid buffore
8655 sslip=sscalelip(fracinbuf)
8656 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8657 eliptran=eliptran+sslip*liptranene(itype(i))
8658 gliptranx(3,i)=gliptranx(3,i)
8659 &+ssgradlip*liptranene(itype(i))
8660 gliptranc(3,i-1)= gliptranc(3,i-1)
8661 &+ssgradlip*liptranene(itype(i))
8662 C print *,"doing sccale for lower part"
8663 elseif (positi.gt.bufliptop) then
8665 &((bordliptop-positi)/lipbufthick)
8666 sslip=sscalelip(fracinbuf)
8667 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8668 eliptran=eliptran+sslip*liptranene(itype(i))
8669 gliptranx(3,i)=gliptranx(3,i)
8670 &+ssgradlip*liptranene(itype(i))
8671 gliptranc(3,i-1)= gliptranc(3,i-1)
8672 &+ssgradlip*liptranene(itype(i))
8673 C print *, "doing sscalefor top part",sslip,fracinbuf
8675 eliptran=eliptran+liptranene(itype(i))
8676 C print *,"I am in true lipid"
8678 endif ! if in lipid or buffor
8680 C eliptran=elpitran+0.0 ! I am in water
8686 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8688 SUBROUTINE MATVEC2(A1,V1,V2)
8689 implicit real*8 (a-h,o-z)
8690 include 'DIMENSIONS'
8691 DIMENSION A1(2,2),V1(2),V2(2)
8695 c 3 VI=VI+A1(I,K)*V1(K)
8699 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8700 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8705 C---------------------------------------
8706 SUBROUTINE MATMAT2(A1,A2,A3)
8707 implicit real*8 (a-h,o-z)
8708 include 'DIMENSIONS'
8709 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8710 c DIMENSION AI3(2,2)
8714 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8720 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8721 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8722 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8723 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8731 c-------------------------------------------------------------------------
8732 double precision function scalar2(u,v)
8734 double precision u(2),v(2)
8737 scalar2=u(1)*v(1)+u(2)*v(2)
8741 C-----------------------------------------------------------------------------
8743 subroutine transpose2(a,at)
8745 double precision a(2,2),at(2,2)
8752 c--------------------------------------------------------------------------
8753 subroutine transpose(n,a,at)
8756 double precision a(n,n),at(n,n)
8764 C---------------------------------------------------------------------------
8765 subroutine prodmat3(a1,a2,kk,transp,prod)
8768 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8770 crc double precision auxmat(2,2),prod_(2,2)
8773 crc call transpose2(kk(1,1),auxmat(1,1))
8774 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8775 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8777 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8778 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8779 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8780 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8781 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8782 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8783 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8784 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8787 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8788 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8790 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8791 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8792 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8793 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8794 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8795 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8796 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8797 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8800 c call transpose2(a2(1,1),a2t(1,1))
8803 crc print *,((prod_(i,j),i=1,2),j=1,2)
8804 crc print *,((prod(i,j),i=1,2),j=1,2)
8808 C-----------------------------------------------------------------------------
8809 double precision function scalar(u,v)
8811 double precision u(3),v(3)
8821 C-----------------------------------------------------------------------
8822 double precision function sscale(r)
8823 double precision r,gamm
8824 include "COMMON.SPLITELE"
8825 if(r.lt.r_cut-rlamb) then
8827 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8828 gamm=(r-(r_cut-rlamb))/rlamb
8829 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8835 C-----------------------------------------------------------------------
8836 C-----------------------------------------------------------------------
8837 double precision function sscagrad(r)
8838 double precision r,gamm
8839 include "COMMON.SPLITELE"
8840 if(r.lt.r_cut-rlamb) then
8842 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8843 gamm=(r-(r_cut-rlamb))/rlamb
8844 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8850 C-----------------------------------------------------------------------
8851 C-----------------------------------------------------------------------
8852 double precision function sscalelip(r)
8853 double precision r,gamm
8854 include "COMMON.SPLITELE"
8855 C if(r.lt.r_cut-rlamb) then
8857 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8858 C gamm=(r-(r_cut-rlamb))/rlamb
8859 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8865 C-----------------------------------------------------------------------
8866 double precision function sscagradlip(r)
8867 double precision r,gamm
8868 include "COMMON.SPLITELE"
8869 C if(r.lt.r_cut-rlamb) then
8871 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8872 C gamm=(r-(r_cut-rlamb))/rlamb
8873 sscagradlip=r*(6*r-6.0d0)
8880 C-----------------------------------------------------------------------
8881 subroutine set_shield_fac
8882 implicit real*8 (a-h,o-z)
8883 include 'DIMENSIONS'
8884 include 'COMMON.CHAIN'
8885 include 'COMMON.DERIV'
8886 include 'COMMON.IOUNITS'
8887 include 'COMMON.SHIELD'
8888 include 'COMMON.INTERACT'
8889 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8890 double precision div77_81/0.974996043d0/,
8891 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8893 C the vector between center of side_chain and peptide group
8894 double precision pep_side(3),long,side_calf(3),
8895 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8896 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8897 C the line belowe needs to be changed for FGPROC>1
8899 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8901 Cif there two consequtive dummy atoms there is no peptide group between them
8902 C the line below has to be changed for FGPROC>1
8905 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8909 C first lets set vector conecting the ithe side-chain with kth side-chain
8910 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8912 C and vector conecting the side-chain with its proper calfa
8913 side_calf(j)=c(j,k+nres)-c(j,k)
8914 C side_calf(j)=2.0d0
8915 pept_group(j)=c(j,i)-c(j,i+1)
8916 C lets have their lenght
8917 dist_pep_side=pep_side(j)**2+dist_pep_side
8918 dist_side_calf=dist_side_calf+side_calf(j)**2
8919 dist_pept_group=dist_pept_group+pept_group(j)**2
8921 dist_pep_side=dsqrt(dist_pep_side)
8922 dist_pept_group=dsqrt(dist_pept_group)
8923 dist_side_calf=dsqrt(dist_side_calf)
8925 pep_side_norm(j)=pep_side(j)/dist_pep_side
8926 side_calf_norm(j)=dist_side_calf
8928 C now sscale fraction
8929 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8930 C print *,buff_shield,"buff"
8932 if (sh_frac_dist.le.0.0) cycle
8933 C If we reach here it means that this side chain reaches the shielding sphere
8934 C Lets add him to the list for gradient
8935 ishield_list(i)=ishield_list(i)+1
8936 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8937 C this list is essential otherwise problem would be O3
8938 shield_list(ishield_list(i),i)=k
8939 C Lets have the sscale value
8940 if (sh_frac_dist.gt.1.0) then
8941 scale_fac_dist=1.0d0
8943 sh_frac_dist_grad(j)=0.0d0
8946 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8947 & *(2.0*sh_frac_dist-3.0d0)
8948 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8949 & /dist_pep_side/buff_shield*0.5
8950 C remember for the final gradient multiply sh_frac_dist_grad(j)
8951 C for side_chain by factor -2 !
8953 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8954 C print *,"jestem",scale_fac_dist,fac_help_scale,
8955 C & sh_frac_dist_grad(j)
8958 C if ((i.eq.3).and.(k.eq.2)) then
8959 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8963 C this is what is now we have the distance scaling now volume...
8964 short=short_r_sidechain(itype(k))
8965 long=long_r_sidechain(itype(k))
8966 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
8969 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
8972 costhet_grad(j)=costhet_fac*pep_side(j)
8974 C remember for the final gradient multiply costhet_grad(j)
8975 C for side_chain by factor -2 !
8976 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
8977 C pep_side0pept_group is vector multiplication
8978 pep_side0pept_group=0.0
8980 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
8982 cosalfa=(pep_side0pept_group/
8983 & (dist_pep_side*dist_side_calf))
8984 fac_alfa_sin=1.0-cosalfa**2
8985 fac_alfa_sin=dsqrt(fac_alfa_sin)
8986 rkprim=fac_alfa_sin*(long-short)+short
8988 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
8989 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
8992 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
8993 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
8994 &*(long-short)/fac_alfa_sin*cosalfa/
8995 &((dist_pep_side*dist_side_calf))*
8996 &((side_calf(j))-cosalfa*
8997 &((pep_side(j)/dist_pep_side)*dist_side_calf))
8999 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9000 &*(long-short)/fac_alfa_sin*cosalfa
9001 &/((dist_pep_side*dist_side_calf))*
9003 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9006 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9009 C now the gradient...
9010 C grad_shield is gradient of Calfa for peptide groups
9011 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9013 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9014 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9016 grad_shield(j,i)=grad_shield(j,i)
9017 C gradient po skalowaniu
9018 & +(sh_frac_dist_grad(j)
9019 C gradient po costhet
9020 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9021 &-scale_fac_dist*(cosphi_grad_long(j))
9022 &/(1.0-cosphi) )*div77_81
9024 C grad_shield_side is Cbeta sidechain gradient
9025 grad_shield_side(j,ishield_list(i),i)=
9026 & (sh_frac_dist_grad(j)*-2.0d0
9027 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9028 & +scale_fac_dist*(cosphi_grad_long(j))
9029 & *2.0d0/(1.0-cosphi))
9030 & *div77_81*VofOverlap
9032 grad_shield_loc(j,ishield_list(i),i)=
9033 & scale_fac_dist*cosphi_grad_loc(j)
9034 & *2.0d0/(1.0-cosphi)
9035 & *div77_81*VofOverlap
9037 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9039 fac_shield(i)=VolumeTotal*div77_81+div4_81
9040 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9044 C--------------------------------------------------------------------------
9045 C first for shielding is setting of function of side-chains
9046 subroutine set_shield_fac2
9047 implicit real*8 (a-h,o-z)
9048 include 'DIMENSIONS'
9049 include 'COMMON.CHAIN'
9050 include 'COMMON.DERIV'
9051 include 'COMMON.IOUNITS'
9052 include 'COMMON.SHIELD'
9053 include 'COMMON.INTERACT'
9054 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9055 double precision div77_81/0.974996043d0/,
9056 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9058 C the vector between center of side_chain and peptide group
9059 double precision pep_side(3),long,side_calf(3),
9060 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9061 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9062 C the line belowe needs to be changed for FGPROC>1
9064 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9066 Cif there two consequtive dummy atoms there is no peptide group between them
9067 C the line below has to be changed for FGPROC>1
9070 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9074 C first lets set vector conecting the ithe side-chain with kth side-chain
9075 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9077 C and vector conecting the side-chain with its proper calfa
9078 side_calf(j)=c(j,k+nres)-c(j,k)
9079 C side_calf(j)=2.0d0
9080 pept_group(j)=c(j,i)-c(j,i+1)
9081 C lets have their lenght
9082 dist_pep_side=pep_side(j)**2+dist_pep_side
9083 dist_side_calf=dist_side_calf+side_calf(j)**2
9084 dist_pept_group=dist_pept_group+pept_group(j)**2
9086 dist_pep_side=dsqrt(dist_pep_side)
9087 dist_pept_group=dsqrt(dist_pept_group)
9088 dist_side_calf=dsqrt(dist_side_calf)
9090 pep_side_norm(j)=pep_side(j)/dist_pep_side
9091 side_calf_norm(j)=dist_side_calf
9093 C now sscale fraction
9094 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9095 C print *,buff_shield,"buff"
9097 if (sh_frac_dist.le.0.0) cycle
9098 C If we reach here it means that this side chain reaches the shielding sphere
9099 C Lets add him to the list for gradient
9100 ishield_list(i)=ishield_list(i)+1
9101 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9102 C this list is essential otherwise problem would be O3
9103 shield_list(ishield_list(i),i)=k
9104 C Lets have the sscale value
9105 if (sh_frac_dist.gt.1.0) then
9106 scale_fac_dist=1.0d0
9108 sh_frac_dist_grad(j)=0.0d0
9111 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9112 & *(2.0d0*sh_frac_dist-3.0d0)
9113 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9114 & /dist_pep_side/buff_shield*0.5d0
9115 C remember for the final gradient multiply sh_frac_dist_grad(j)
9116 C for side_chain by factor -2 !
9118 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9119 C sh_frac_dist_grad(j)=0.0d0
9120 C scale_fac_dist=1.0d0
9121 C print *,"jestem",scale_fac_dist,fac_help_scale,
9122 C & sh_frac_dist_grad(j)
9125 C this is what is now we have the distance scaling now volume...
9126 short=short_r_sidechain(itype(k))
9127 long=long_r_sidechain(itype(k))
9128 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9129 sinthet=short/dist_pep_side*costhet
9133 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9134 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9135 C & -short/dist_pep_side**2/costhet)
9138 costhet_grad(j)=costhet_fac*pep_side(j)
9140 C remember for the final gradient multiply costhet_grad(j)
9141 C for side_chain by factor -2 !
9142 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9143 C pep_side0pept_group is vector multiplication
9144 pep_side0pept_group=0.0d0
9146 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9148 cosalfa=(pep_side0pept_group/
9149 & (dist_pep_side*dist_side_calf))
9150 fac_alfa_sin=1.0d0-cosalfa**2
9151 fac_alfa_sin=dsqrt(fac_alfa_sin)
9152 rkprim=fac_alfa_sin*(long-short)+short
9156 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9158 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9159 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9163 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9164 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9165 &*(long-short)/fac_alfa_sin*cosalfa/
9166 &((dist_pep_side*dist_side_calf))*
9167 &((side_calf(j))-cosalfa*
9168 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9169 C cosphi_grad_long(j)=0.0d0
9170 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9171 &*(long-short)/fac_alfa_sin*cosalfa
9172 &/((dist_pep_side*dist_side_calf))*
9174 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9175 C cosphi_grad_loc(j)=0.0d0
9177 C print *,sinphi,sinthet
9178 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9181 C now the gradient...
9183 grad_shield(j,i)=grad_shield(j,i)
9184 C gradient po skalowaniu
9185 & +(sh_frac_dist_grad(j)*VofOverlap
9186 C gradient po costhet
9187 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9188 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9189 & sinphi/sinthet*costhet*costhet_grad(j)
9190 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9192 C grad_shield_side is Cbeta sidechain gradient
9193 grad_shield_side(j,ishield_list(i),i)=
9194 & (sh_frac_dist_grad(j)*-2.0d0
9196 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9197 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9198 & sinphi/sinthet*costhet*costhet_grad(j)
9199 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9202 grad_shield_loc(j,ishield_list(i),i)=
9203 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9204 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9205 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9209 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9211 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9212 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9213 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9218 C-----------------------------------------------------------------------
9219 C-----------------------------------------------------------
9220 C This subroutine is to mimic the histone like structure but as well can be
9221 C utilizet to nanostructures (infinit) small modification has to be used to
9222 C make it finite (z gradient at the ends has to be changes as well as the x,y
9223 C gradient has to be modified at the ends
9224 C The energy function is Kihara potential
9225 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
9226 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
9227 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
9228 C simple Kihara potential
9229 subroutine calctube(Etube)
9230 implicit real*8 (a-h,o-z)
9231 include 'DIMENSIONS'
9232 include 'COMMON.GEO'
9233 include 'COMMON.VAR'
9234 include 'COMMON.LOCAL'
9235 include 'COMMON.CHAIN'
9236 include 'COMMON.DERIV'
9237 include 'COMMON.INTERACT'
9238 include 'COMMON.IOUNITS'
9239 include 'COMMON.CALC'
9240 include 'COMMON.CONTROL'
9241 include 'COMMON.SPLITELE'
9242 include 'COMMON.SBRIDGE'
9243 double precision tub_r,vectube(3),enetube(maxres*2)
9245 do i=itube_start,itube_end
9247 enetube(i+nres)=0.0d0
9249 C first we calculate the distance from tube center
9250 C first sugare-phosphate group for NARES this would be peptide group
9252 do i=itube_start,itube_end
9253 C lets ommit dummy atoms for now
9254 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
9255 C now calculate distance from center of tube and direction vectors
9259 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9260 vectube(1)=vectube(1)+boxxsize*j
9261 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9262 vectube(2)=vectube(2)+boxysize*j
9264 xminact=abs(vectube(1)-tubecenter(1))
9265 yminact=abs(vectube(2)-tubecenter(2))
9266 if (xmin.gt.xminact) then
9270 if (ymin.gt.yminact) then
9277 vectube(1)=vectube(1)-tubecenter(1)
9278 vectube(2)=vectube(2)-tubecenter(2)
9280 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
9281 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
9283 C as the tube is infinity we do not calculate the Z-vector use of Z
9286 C now calculte the distance
9287 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9288 C now normalize vector
9289 vectube(1)=vectube(1)/tub_r
9290 vectube(2)=vectube(2)/tub_r
9291 C calculte rdiffrence between r and r0
9295 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9296 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
9297 C write(iout,*) "TU13",i,rdiff6,enetube(i)
9298 C print *,rdiff,rdiff6,pep_aa_tube
9299 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9300 C now we calculate gradient
9301 fac=(-12.0d0*pep_aa_tube/rdiff6-
9302 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
9303 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
9306 C now direction of gg_tube vector
9308 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
9309 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
9312 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
9313 C print *,gg_tube(1,0),"TU"
9316 do i=itube_start,itube_end
9317 C Lets not jump over memory as we use many times iti
9319 C lets ommit dummy atoms for now
9321 C in UNRES uncomment the line below as GLY has no side-chain...
9327 vectube(1)=mod((c(1,i+nres)),boxxsize)
9328 vectube(1)=vectube(1)+boxxsize*j
9329 vectube(2)=mod((c(2,i+nres)),boxysize)
9330 vectube(2)=vectube(2)+boxysize*j
9332 xminact=abs(vectube(1)-tubecenter(1))
9333 yminact=abs(vectube(2)-tubecenter(2))
9334 if (xmin.gt.xminact) then
9338 if (ymin.gt.yminact) then
9345 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
9347 vectube(1)=vectube(1)-tubecenter(1)
9348 vectube(2)=vectube(2)-tubecenter(2)
9350 C as the tube is infinity we do not calculate the Z-vector use of Z
9353 C now calculte the distance
9354 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9355 C now normalize vector
9356 vectube(1)=vectube(1)/tub_r
9357 vectube(2)=vectube(2)/tub_r
9359 C calculte rdiffrence between r and r0
9363 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9364 sc_aa_tube=sc_aa_tube_par(iti)
9365 sc_bb_tube=sc_bb_tube_par(iti)
9366 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
9367 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9368 C now we calculate gradient
9369 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
9370 & 6.0d0*sc_bb_tube/rdiff6/rdiff
9371 C now direction of gg_tube vector
9373 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
9374 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
9377 do i=itube_start,itube_end
9378 Etube=Etube+enetube(i)+enetube(i+nres)
9380 C print *,"ETUBE", etube
9383 C TO DO 1) add to total energy
9384 C 2) add to gradient summation
9385 C 3) add reading parameters (AND of course oppening of PARAM file)
9386 C 4) add reading the center of tube
9388 C 6) add to zerograd
9390 C-----------------------------------------------------------------------
9391 C-----------------------------------------------------------
9392 C This subroutine is to mimic the histone like structure but as well can be
9393 C utilizet to nanostructures (infinit) small modification has to be used to
9394 C make it finite (z gradient at the ends has to be changes as well as the x,y
9395 C gradient has to be modified at the ends
9396 C The energy function is Kihara potential
9397 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
9398 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
9399 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
9400 C simple Kihara potential
9401 subroutine calctube2(Etube)
9402 implicit real*8 (a-h,o-z)
9403 include 'DIMENSIONS'
9404 include 'COMMON.GEO'
9405 include 'COMMON.VAR'
9406 include 'COMMON.LOCAL'
9407 include 'COMMON.CHAIN'
9408 include 'COMMON.DERIV'
9409 include 'COMMON.INTERACT'
9410 include 'COMMON.IOUNITS'
9411 include 'COMMON.CALC'
9412 include 'COMMON.CONTROL'
9413 include 'COMMON.SPLITELE'
9414 include 'COMMON.SBRIDGE'
9415 double precision tub_r,vectube(3),enetube(maxres*2)
9417 do i=itube_start,itube_end
9419 enetube(i+nres)=0.0d0
9421 C first we calculate the distance from tube center
9422 C first sugare-phosphate group for NARES this would be peptide group
9424 do i=itube_start,itube_end
9425 C lets ommit dummy atoms for now
9427 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
9428 C now calculate distance from center of tube and direction vectors
9429 C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9430 C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
9431 C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9432 C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
9436 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9437 vectube(1)=vectube(1)+boxxsize*j
9438 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9439 vectube(2)=vectube(2)+boxysize*j
9441 xminact=abs(vectube(1)-tubecenter(1))
9442 yminact=abs(vectube(2)-tubecenter(2))
9443 if (xmin.gt.xminact) then
9447 if (ymin.gt.yminact) then
9454 vectube(1)=vectube(1)-tubecenter(1)
9455 vectube(2)=vectube(2)-tubecenter(2)
9457 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
9458 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
9460 C as the tube is infinity we do not calculate the Z-vector use of Z
9463 C now calculte the distance
9464 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9465 C now normalize vector
9466 vectube(1)=vectube(1)/tub_r
9467 vectube(2)=vectube(2)/tub_r
9468 C calculte rdiffrence between r and r0
9472 C THIS FRAGMENT MAKES TUBE FINITE
9473 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
9474 if (positi.le.0) positi=positi+boxzsize
9475 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9476 c for each residue check if it is in lipid or lipid water border area
9477 C respos=mod(c(3,i+nres),boxzsize)
9478 print *,positi,bordtubebot,buftubebot,bordtubetop
9479 if ((positi.gt.bordtubebot)
9480 & .and.(positi.lt.bordtubetop)) then
9481 C the energy transfer exist
9482 if (positi.lt.buftubebot) then
9484 & ((positi-bordtubebot)/tubebufthick)
9485 C lipbufthick is thickenes of lipid buffore
9486 sstube=sscalelip(fracinbuf)
9487 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
9488 print *,ssgradtube, sstube,tubetranene(itype(i))
9489 enetube(i)=enetube(i)+sstube*tubetranenepep
9490 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9491 C &+ssgradtube*tubetranene(itype(i))
9492 C gg_tube(3,i-1)= gg_tube(3,i-1)
9493 C &+ssgradtube*tubetranene(itype(i))
9494 C print *,"doing sccale for lower part"
9495 elseif (positi.gt.buftubetop) then
9497 &((bordtubetop-positi)/tubebufthick)
9498 sstube=sscalelip(fracinbuf)
9499 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
9500 enetube(i)=enetube(i)+sstube*tubetranenepep
9501 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9502 C &+ssgradtube*tubetranene(itype(i))
9503 C gg_tube(3,i-1)= gg_tube(3,i-1)
9504 C &+ssgradtube*tubetranene(itype(i))
9505 C print *, "doing sscalefor top part",sslip,fracinbuf
9509 enetube(i)=enetube(i)+sstube*tubetranenepep
9510 C print *,"I am in true lipid"
9516 endif ! if in lipid or buffor
9518 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9519 enetube(i)=enetube(i)+sstube*
9520 &(pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
9521 C write(iout,*) "TU13",i,rdiff6,enetube(i)
9522 C print *,rdiff,rdiff6,pep_aa_tube
9523 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9524 C now we calculate gradient
9525 fac=(-12.0d0*pep_aa_tube/rdiff6-
9526 & 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
9527 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
9530 C now direction of gg_tube vector
9532 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
9533 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
9535 gg_tube(3,i)=gg_tube(3,i)
9536 &+ssgradtube*enetube(i)/sstube/2.0d0
9537 gg_tube(3,i-1)= gg_tube(3,i-1)
9538 &+ssgradtube*enetube(i)/sstube/2.0d0
9541 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
9542 C print *,gg_tube(1,0),"TU"
9543 do i=itube_start,itube_end
9544 C Lets not jump over memory as we use many times iti
9546 C lets ommit dummy atoms for now
9548 C in UNRES uncomment the line below as GLY has no side-chain...
9551 vectube(1)=c(1,i+nres)
9552 vectube(1)=mod(vectube(1),boxxsize)
9553 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
9554 vectube(2)=c(2,i+nres)
9555 vectube(2)=mod(vectube(2),boxysize)
9556 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
9558 vectube(1)=vectube(1)-tubecenter(1)
9559 vectube(2)=vectube(2)-tubecenter(2)
9560 C THIS FRAGMENT MAKES TUBE FINITE
9561 positi=(mod(c(3,i+nres),boxzsize))
9562 if (positi.le.0) positi=positi+boxzsize
9563 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9564 c for each residue check if it is in lipid or lipid water border area
9565 C respos=mod(c(3,i+nres),boxzsize)
9566 print *,positi,bordtubebot,buftubebot,bordtubetop
9567 if ((positi.gt.bordtubebot)
9568 & .and.(positi.lt.bordtubetop)) then
9569 C the energy transfer exist
9570 if (positi.lt.buftubebot) then
9572 & ((positi-bordtubebot)/tubebufthick)
9573 C lipbufthick is thickenes of lipid buffore
9574 sstube=sscalelip(fracinbuf)
9575 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
9576 print *,ssgradtube, sstube,tubetranene(itype(i))
9577 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
9578 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9579 C &+ssgradtube*tubetranene(itype(i))
9580 C gg_tube(3,i-1)= gg_tube(3,i-1)
9581 C &+ssgradtube*tubetranene(itype(i))
9582 C print *,"doing sccale for lower part"
9583 elseif (positi.gt.buftubetop) then
9585 &((bordtubetop-positi)/tubebufthick)
9586 sstube=sscalelip(fracinbuf)
9587 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
9588 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
9589 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9590 C &+ssgradtube*tubetranene(itype(i))
9591 C gg_tube(3,i-1)= gg_tube(3,i-1)
9592 C &+ssgradtube*tubetranene(itype(i))
9593 C print *, "doing sscalefor top part",sslip,fracinbuf
9597 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
9598 C print *,"I am in true lipid"
9604 endif ! if in lipid or buffor
9605 CEND OF FINITE FRAGMENT
9606 C as the tube is infinity we do not calculate the Z-vector use of Z
9609 C now calculte the distance
9610 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9611 C now normalize vector
9612 vectube(1)=vectube(1)/tub_r
9613 vectube(2)=vectube(2)/tub_r
9614 C calculte rdiffrence between r and r0
9618 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9619 sc_aa_tube=sc_aa_tube_par(iti)
9620 sc_bb_tube=sc_bb_tube_par(iti)
9621 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)
9622 & *sstube+enetube(i+nres)
9623 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9624 C now we calculate gradient
9625 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
9626 & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
9627 C now direction of gg_tube vector
9629 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
9630 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
9632 gg_tube_SC(3,i)=gg_tube_SC(3,i)
9633 &+ssgradtube*enetube(i+nres)/sstube
9634 gg_tube(3,i-1)= gg_tube(3,i-1)
9635 &+ssgradtube*enetube(i+nres)/sstube
9638 do i=itube_start,itube_end
9639 Etube=Etube+enetube(i)+enetube(i+nres)
9641 C print *,"ETUBE", etube
9644 C TO DO 1) add to total energy
9645 C 2) add to gradient summation
9646 C 3) add reading parameters (AND of course oppening of PARAM file)
9647 C 4) add reading the center of tube
9649 C 6) add to zerograd
9652 C#-------------------------------------------------------------------------------
9653 C This subroutine is to mimic the histone like structure but as well can be
9654 C utilizet to nanostructures (infinit) small modification has to be used to
9655 C make it finite (z gradient at the ends has to be changes as well as the x,y
9656 C gradient has to be modified at the ends
9657 C The energy function is Kihara potential
9658 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
9659 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
9660 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
9661 C simple Kihara potential
9662 subroutine calcnano(Etube)
9663 implicit real*8 (a-h,o-z)
9664 include 'DIMENSIONS'
9665 include 'COMMON.GEO'
9666 include 'COMMON.VAR'
9667 include 'COMMON.LOCAL'
9668 include 'COMMON.CHAIN'
9669 include 'COMMON.DERIV'
9670 include 'COMMON.INTERACT'
9671 include 'COMMON.IOUNITS'
9672 include 'COMMON.CALC'
9673 include 'COMMON.CONTROL'
9674 include 'COMMON.SPLITELE'
9675 include 'COMMON.SBRIDGE'
9676 double precision tub_r,vectube(3),enetube(maxres*2),
9677 & enecavtube(maxres*2)
9679 do i=itube_start,itube_end
9681 enetube(i+nres)=0.0d0
9683 C first we calculate the distance from tube center
9684 C first sugare-phosphate group for NARES this would be peptide group
9686 do i=itube_start,itube_end
9687 C lets ommit dummy atoms for now
9688 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
9689 C now calculate distance from center of tube and direction vectors
9695 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9696 vectube(1)=vectube(1)+boxxsize*j
9697 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9698 vectube(2)=vectube(2)+boxysize*j
9699 vectube(3)=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
9700 vectube(3)=vectube(3)+boxzsize*j
9703 xminact=abs(vectube(1)-tubecenter(1))
9704 yminact=abs(vectube(2)-tubecenter(2))
9705 zminact=abs(vectube(3)-tubecenter(3))
9707 if (xmin.gt.xminact) then
9711 if (ymin.gt.yminact) then
9715 if (zmin.gt.zminact) then
9724 vectube(1)=vectube(1)-tubecenter(1)
9725 vectube(2)=vectube(2)-tubecenter(2)
9726 vectube(3)=vectube(3)-tubecenter(3)
9728 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
9729 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
9730 C as the tube is infinity we do not calculate the Z-vector use of Z
9733 C now calculte the distance
9734 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9735 C now normalize vector
9736 vectube(1)=vectube(1)/tub_r
9737 vectube(2)=vectube(2)/tub_r
9738 vectube(3)=vectube(3)/tub_r
9739 C calculte rdiffrence between r and r0
9743 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9744 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
9745 C write(iout,*) "TU13",i,rdiff6,enetube(i)
9746 C print *,rdiff,rdiff6,pep_aa_tube
9747 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9748 C now we calculate gradient
9749 fac=(-12.0d0*pep_aa_tube/rdiff6-
9750 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
9751 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
9753 if (acavtubpep.eq.0.0d0) then
9758 denominator=(1.0+dcavtubpep*rdiff6*rdiff6)
9760 & (bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)+ccavtubpep)
9763 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/sqrt(rdiff))
9764 & *denominator-(bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)
9765 & +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0)
9766 & /denominator**2.0d0
9771 C print *,"TUT",i,iti,rdiff,rdiff6,acavtubpep,denominator,
9772 C & enecavtube(i),faccav
9774 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
9775 CX print *,"finene=",enetube(i+nres)+enecavtube(i)
9777 C now direction of gg_tube vector
9779 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
9780 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
9784 do i=itube_start,itube_end
9786 C Lets not jump over memory as we use many times iti
9788 C lets ommit dummy atoms for now
9790 C in UNRES uncomment the line below as GLY has no side-chain...
9797 vectube(1)=mod((c(1,i+nres)),boxxsize)
9798 vectube(1)=vectube(1)+boxxsize*j
9799 vectube(2)=mod((c(2,i+nres)),boxysize)
9800 vectube(2)=vectube(2)+boxysize*j
9801 vectube(3)=mod((c(3,i+nres)),boxzsize)
9802 vectube(3)=vectube(3)+boxzsize*j
9805 xminact=abs(vectube(1)-tubecenter(1))
9806 yminact=abs(vectube(2)-tubecenter(2))
9807 zminact=abs(vectube(3)-tubecenter(3))
9809 if (xmin.gt.xminact) then
9813 if (ymin.gt.yminact) then
9817 if (zmin.gt.zminact) then
9826 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
9828 vectube(1)=vectube(1)-tubecenter(1)
9829 vectube(2)=vectube(2)-tubecenter(2)
9830 vectube(3)=vectube(3)-tubecenter(3)
9831 C now calculte the distance
9832 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9833 C now normalize vector
9834 vectube(1)=vectube(1)/tub_r
9835 vectube(2)=vectube(2)/tub_r
9836 vectube(3)=vectube(3)/tub_r
9838 C calculte rdiffrence between r and r0
9842 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9843 sc_aa_tube=sc_aa_tube_par(iti)
9844 sc_bb_tube=sc_bb_tube_par(iti)
9845 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
9846 C enetube(i+nres)=0.0d0
9847 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9848 C now we calculate gradient
9849 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
9850 & 6.0d0*sc_bb_tube/rdiff6/rdiff
9852 C now direction of gg_tube vector
9853 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
9854 if (acavtub(iti).eq.0.0d0) then
9856 enecavtube(i+nres)=0.0
9859 denominator=(1.0+dcavtub(iti)*rdiff6*rdiff6)
9861 & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
9864 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/sqrt(rdiff))
9865 & *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)
9866 & +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0)
9867 & /denominator**2.0d0
9872 C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
9873 C & enecavtube(i),faccav
9875 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
9876 C print *,"finene=",enetube(i+nres)+enecavtube(i)
9878 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
9879 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
9882 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
9883 C do i=itube_start,itube_end
9886 C if (acavtub(iti).eq.0.0) cycle
9890 do i=itube_start,itube_end
9891 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i)
9892 & +enecavtube(i+nres)
9894 C print *,"ETUBE", etube
9897 C TO DO 1) add to total energy
9898 C 2) add to gradient summation
9899 C 3) add reading parameters (AND of course oppening of PARAM file)
9900 C 4) add reading the center of tube
9902 C 6) add to zerograd